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DUMP.DEF is referenced in "The OS/2 Applications Family," by Ray Duncan, 
BYTE, October, 1987 page 102. 


Module definition file: DUMP.DEF 


NAME DUMP 
PROTMODE 
DATA MOVEABLE 
CODE MOVEABLE PURE 
STACKSIZE 4096 


MAKE file: DUMP 


dump.obj : dump.asm 
masm /Zi dump; 

dump.exe : dump.obj dump.def dump 
link /CO dump,,,doscalIs,dump 


DUMP.C is referenced in "The OS/2 Applications Family," by Ray Duncan, BYTE, 
October, 1987, page 102. 


Here is the C code for the DUMP.C program to demonstrate semaphores, 
multiple threads, etc. from high level. 


/* 


DUMP.C 


Displays the binary contents of a file in 
hex and ASCII on the standard output device. 


Program has been deliberately complicated 
to demonstrate direct calls from C to 
operating system, use of multiple threads, 
and synchronization with semaphores. 

Usage is: ODUMP unit:path\filename.ext [ destination ] 

Compile with: C>CL /AL /Zi /Gs /F 2000 DUMP.C 

V 


iHinclude <stdio.h> 
#include <malloc.h> 

#include <doscalls.h> 


define REC SIZE 16 

/* 

define STK_SIZE 1024 

/* 

char Bufl[REC_SIZE]; 

/* 

unsigned BuflLen; 

/* 

char Buf2[REC_SIZE]? 

/* 

unsigned Buf2Len; 

/* 

unsigned Handle? 

/* 

long filptr; 

/* 

unsigned long ExitSem? 

/* 

unsigned long BuflFullSem; 
unsigned long BuflEmptySem; 

/* 

unsigned long Buf2FullSem? 
unsigned long Buf2EmptySem; 

/* 


size of file records */ 
stack size for threads */ 

first disk buffer */ 
amount of data in buffer */ 

second disk buffer */ 
amount of data in buffer */ 

file Handle from DOSOPEN */ 
file offset in bytes */ 

semaphore for process exit */ 
semaphores for disk buffer #1 */ 

semaphores for disk buffer #2 */ 


continued 
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main(int argc, char *argv[]) 

/* entry point for Display Thread */ 
/* entry point for Disk Thread */ 

/* receives Thread ID */ 

/* receives Thread ID */ 

/* allocate stacks for threads */ 

/* receives DOSOPEN rooult */ 

/* fail open if file not found */ 

/* read only, deny none */ 

/* initializo file pointer */ 

/* initialize nemaphores */ 


_ /* « Ih'< k command tail */ 

{ fprintf(stderr,”\ndump: mlrmlng file name\n"); 

exit( 1 ); 

/* open file or exit */ 

if (DOSOPEN (argv| 1 ) , fclland I «*, faction, OL, 0 , openf lag, openmode, OL)) 

( f pi i nt f ( nt dm i , M n .. « in' t t i nd file %s\n" , argv[ 1 ]) ? 

exit(1)/ 

/* create Disk Thread */ 
l i (DONUM A'i i TIMM:AI>(()inkThr, & DiskThrID, DiskThrStk+STK_SIZE)) 

( f pi l ill f ( nt Mm i , ”\ndump: can’t create Disk Thread”); 
exit(1) / 

/* Create Display Thread */ 

l i (DOM I i ATi:THUEAD(DisplayThr,&DisplayThrID, DisplayThrStk+STK__SIZE)) 
( fpilnil(ntderr,”\ndump: can’t create Display Thread”)? 
exit(1) ? 


void far DisplayThr(); 
void far DiskThr()/ 

unsigned DinplayTln ID; 
unsigned Dl nk'Phi I D/ 

ohai mini ze) ? 

rhai liInTNit ,U I | MTK SIZE) ? 

lid openf I ag-OxOl; 
lid npcimimde-0x40,* 

f l I pt i -OL; 

ExitSem-OL; 

Hu f1EmptySem= Bu f1Fu11Sem= 0 L; 

Bu f 2 EmptySem=Bu f 2 Fu1lSem=0 L ? 
DOSSEMSET((long) &ExitSem); 
DOSSEMSET((long) &BuflFullSem); 
DOSSEMSET((long) &Buf2FullSom); 

if (argc < 2) 


DOSSEMWAIT((long) &ExitSem,-1L)? 

DOSSUSPENDTHREAD(DiskThrlD)? 
DOSSUSPENDTHREAD(DisplayThrlD)? 
DOSCLOSE(Handle); 

DOSEXIT(1,0); 


/* wait for exit signal */ 

/* suspend other threads */ 

/* close file */ 

/* terminate all threads */ 


/* 

The Disk Thread reads the disk file, alternating between 
Bufl and Buf2. This thread gets terminated externally 
when the other threads see end of file has been reached. 
V 

void far DiskThr() 


( 


while(l) 

( D0SREAD(Handle,Buf1,RECSIZE,&BuflLen); 

SemFlip(&BuflEmptySem,&BuflFullSem)? 
DOSSEMWAIT((long) &Buf2EmptySem,-1L)? 
DOSREAD(Handle,Buf2,RECSIZE,&Buf2Len); 
SemFlip(&Buf2EmptySem,&Buf2FullSem)? 
DOSSEMWAIT((long) &BuflEmptySem,-1L)? 

) 


/* read disk */ 

/* mark buffer 1 full */ 

/* wait for buffer 2 empty */ 
/* read disk */ 

/* mark buffer 2 full */ 

/* wait for buffer 1 empty */ 


) 


/* 

The Display Thread formats and displays the data in the 
disk buffers, alternating between Bufl and Buf2. 

V 

void far DisplayThr() 


{ 

while(1) 

( DOSSEMWAIT((long) &BuflFullSem,-1L)? 
DumpRec(Buf1,BuflLen)? 

SemFlip(&BuflFullSem,&BuflEmptySem); 
DOSSEMWAIT((long) &Buf2FullSem,-1L); 
DumpRec(Buf2,Buf2Len)? 

SemFlip(&Buf2FullSem,&Buf2EmptySem); 

) 

} 


/* wait for buffer 1 full */ 
/* format and display it */ 
/* mark buffer 1 empty */ 

/* wait for buffer 2 full */ 
/* format and display it */ 
/* mark buffer 2 empty */ 
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/* 

Display record in hex and ASCII on standard output. 

Clear exit semaphore and terminate thread if record length=0. 

V 


DumpRec(char *buffer,int length) 

( 

int i; 

if (length«0) 

{ DOSSEMCLEAR((long) fiExitSem) 
DOSEXIT(0,0); 

) 

if (filptr % 128 — 0) 

printf("\n\n 012 

printf("\n%041X ",filptr)? 


/* index to current record */ 

/* check if record length = 0 */ 
/* yes, signal main thread */ 

/* and terminate this thread! */ 


/* maybe print heading */ 

: 5 6 7 8 9 A B C D E F") ? 

/* file offset */ 


for (i - 0; i < length? i++) /* print hex equiv. of each byte */ 

printf( " %02X", (unsigned char) buffer(i) )? 

/* space over if partial record */ 
if (length !« 16) for(i«0? i<(16-length) ? i++) printf (" ") ? 


printf(" ")? 


for (i “ 0? i < length; i++) /* print ASCII equiv. of bytes */ 

( if (buffer(i) < 32 | | buffer(i) > 126) putchar( 1 .•)? 
else putchar(buffer[i])? 

) 

filptr += REC_SIZE; /* update file offset */ 


Since there is no operation to wait until a semaphore 
is set, we must maintain two semaphores to control each 
buffer and flip them atomically. 


V 

SemFlip(long *seml, long *sem2) 
( DOSENTERCRITSEC()? 

DOSSEMSET((long) semi); 
DOSSEMCLEAR((long) sem2)? 
D0SEXITCRITSECO ; 


/* block other threads */ 

/* set the first semaphore */ 

/* clear the second semaphore */ 
/* unblock other threads */ 


) 


DUMP.ASM is referenced in M The OS/2 Applications Family," by Ray Duncan, 
BYTE, October, 1987 page 102. 


DUMP.ASM 

name dump 

page 55,132 

title DUMP - Display File Contents 

.286c 

DUMP.ASM - a OS/2 utility to display the contents of a 

file on the standard output in hex and ASCII format. 

Copyright (C) 1987 Ray Duncan 

Usage: ODUMP path\filename.ext ( >device ) 

This program has been intentionally complicated 
to demonstrate the use of multiple threads and semaphores 
in a MASM application. For a roadmap to what is going 


? on in 

? 

this 

program, 

see its counterpart DUMP.C. 

cr 

equ 

Odh 

? 

ASCII carriage return 

If 

equ 

Oah 

i 

ASCII line feed 

blank 

equ 

2 Oh 

i 

ASCII space code 

tab 

equ 

09h 

t 

ASCII tab code 

recsize 

equ 

16 

; 

size of input file records 

stksize 

equ 

2048 

S 

size of stack for threads 

stdout 

equ 

1 

? 

handle of standard output device 

r.tderr 

equ 

2 

? 

handle of standard error device 


continued 
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extrn 

DOSOPEN 

:far ; references to OS/2 services 

extrn 

DOSREAD 

: far 


extrn 

DOSWRITE:far 


extrn 

DOSCLOSE:far 


extrn 

DOSEXIT1f«i 


extrn 

DOSSEMCLEARtfar 


oxtrn 

ho:.:.|:MM T: f 


oxtrn 

DOSSEMWAIT:far 


oxtrn 

DOSALLOCSEOtfar 


oxtrn 

DOflCREATETHREAD: far 


oxtrn 

DOSSUSPENDTHREAD: far 


oxtrn 

DONKNTERCRITSEC: far 


oxtrn 

DOSEXITCRITSEC:far 


oxtrn 

DOSGETENV:far 


DGROUP group 

_DATA 



DATA 

segment 

word public 'DATA' 

ExitSem 

dd 

0 

? storage for RAM semaphores 

BuflFullSem 

dd 

0 


BuflEmptySem 

dd 

0 


Buf2FullSem 

dd 

0 


Buf2EmptySem 

dd 

0 


DisplayThrlD 

dw 

0 

; Display thread ID 

DiskThrlD 

dw 

0 

; Disk I/O thread ID 

Buf 1 

db 

recsize dup (0) 

; disk I/O buffer |1 

BuflLen 

dw 

0 

? length of buffer |1 data 

Buf 2 

db 

recsize dup (0) 

; disk I/O buffer I2 

Buf 2Len 

dw 

0 

; length of buffer |2 data 

fnamo 

db 

64 dup (0) 

; ASCI IZ nnmn of input file 

fhand)n 

dw 

0 

; handlo for input file 

filptr 

dw 

0 

; relative address in file 

mi nl tin 

dw 

0 

; receives status of DOSOPEN 

no 1oot or 

dw 

0 

? receives segment selector 




? from DOSALLOCSEG 




; formatting area for output 

output 

db 

'nnnn',blank,blank 

outputa 

db 

16 dup ('nn',blank) 


db 

blank 


outputb 

db 

16 dup (blank), 

cr. If 

output_len 

equ 

$-output 


heading 

db 

cr, If 

; heading for each 128 bytes 


db 

7 dup (blank) 



db 

'01234 

5 6 7' 


db 

•8 9 A B C 

D E F',cr,lf 

heading_len 

equ 

$-heading 


msgl 

db 

cr, If 



db 

'dump: file not 

found' 


db 

cr, If 


msgl_len 

equ 

$-msgl 


msg2 

db 

cr, If 



db 

'dump: missing 

file name' 


db 

cr, If 


msg2_len 

equ 

$-msg2 


msg3 

db 

cr, If 



db 

'dump: memory allocation error' 


db 

cr, If 


msg3_len 

equ 

$-msg3 


rasg4 

db 

cr, If 



db 

•dump: create thread failed' 


db 

cr, If 


msg4_len 

equ 

$-msg4 


_DATA 

ends 



__TEXT segment 

word public ‘CODE' 


assume 

csjTEXT 

,ds:DGROUP 


dump proc 

far 


; entry point from OS/2 
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dumpl: 


dumpl5: 


dump2: 


dump3: 


dump4: 


dump5: 


dump6: 


call 

argc 

; 

cmp 

ax, 2 


je 

dumpl 

? 

mov 

dx,offset msg2 

t 

mov 

cx,msg2_len 


jmp 

dump9 

• 

t 

mov 

ax, 1 

i 

t 

call 

argv 


mov 

cx,ax 

! 

mov 

di,offset fname 

i 

mov 

al,es:[bx] 

; 

mov 

[di],al 


inc 

bx 


inc 

di 


loop 

dumpl5 


push 

ds 

s 

pop 

es 


push 

ds 

i 

i 

push 

offset DGROUP:fname 


push 

ds 

? 

push 

offset DGROUP:fhandle 


push 

ds 

? 

push 

offset DGROUP:status 


push 

0 

? 

push 

0 


push 

0 

i 

push 

1 

S 

push 

4 Oh 

t 

push 

0 

t 

push 

0 


call 

DOSOPEN 

r 

or 

ax, ax 

? 

jz 

dump3 

t 

mov 

dx,offset msgl 

t 

mov 

cx,msgl_len 


jmp 

dump9 

i 

push 

ds 

. 

f 

push 

offset DGROUP:ExitSem 


call 

DOSSEMSET 


push 

ds 


push 

offset DGROUP:BuflFullSem 

call 

DOSSEMSET 


push 

ds 


push 

offset DGROUP:Buf2FullSem 

call 

DOSSEMSET 


push 

stksize 

i 

i 

push 

ds 

; 

push 

offset DGROUP:selector 

s 

push 

0 

s 

call 

DOSALLOCSEG 

s 

or 

ax, ax 

t 

jz 

dump5 

1 

mov 

dx,offset DGROUP:msg3 

» 

mov 

cx,msg3__len 

; 

jmp 

dump9 

? 

push 

cs 

. 

push 

offset _TEXT:DiskThread 


push 

ds 

> 

push 

offset DGROUP:DiskThrlD 


push 

selector 

• 

i 

push 

stksize 


call 

DOSCREATETHREAD 

• 

« 

or 

ax,ax 

s 

jz 

dump7 

t 

mov 

dx,offset DGROUP:msg4 

i 

mov 

cx,msg4_len 

? 

jmp 

dump9 

? 


is filename present? 
yes, proceed 

missing or illegal filespec, 

print error message and exit. 

copy filename to local buffer 
get ES:BX = filename 

set CX = length 
DS:DI = local buffer 
copy it byte by byte 


set ES = DS 


now try to open file... 

ASCIIZ file name 

receives handle 

receives handle 

file size (ignored) 

file attribute = normal 
OpenFlag = fail if doesn't exist 
OpenMode = deny none,read only 
DWORD reserved 

transfer to OS/2 
test status 

jump if open succeeded 
open of input file failed, 
print error msg and exit, 
initialize semaphores 


allocate Disk Thread stack 
size of stack 
receives selector for 
allocated block 
0 ■ segment not shareable 
transfer to OS/2 
test status 

jump if allocation succeeded 

display message 
'memory allocation error* 
and exit 

create Disk Thread 
thread's entry point 

receives thread ID 

thread's stack base 

transfer to OS/2 
test status 

jump if create succeeded 

create of thread failed, 
display error message 
and exit 


continued 
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dump7: 

push 

push 

push 

push 

call 

or 

jn« 


stksizo 

ds 

offnot DGROUP:nnI actor 

0 

DOfALLOCSBO 
ax, ax 
dump4 


; allocate Display Thread stack 
; n izo of stack 
; receives selector for 
; allocated block 
j 0 - segment not shareable 
; transfer to OS/2 
? test status 

; jump if allocation failed 


puah 

puah 

pUMh 

puah 

push 

push 

call 

or 

jnz 


? create Display Thread 

on ? thread*s entry point 

Offset JTEXT:DisplayThread 

dn ; receives thread ID 

offset DGROUP:DisplayThrlD 

selector ; thread*s stack base 

stksize 


DOSCREATETHREAD 

ax, ax 

dump6 


transfer to OS/2 

test status 

jump if create failed 


push ds 

push offset DGROUP:ExitSem 

push -1 

push -1 

call DOSSEMWAIT 

push DiskThrlD 

call DOSSUSPENDTHREAD 

push DisplayThrlD 

call DOSSUSPENDTHREAD 


? now wait on exit semaphore 

; (it will be triggered 

; by routine DumpRec when 
; end of file is reached) 

; transfer to OS/2 

? suspend Disk Thread 
? transfer to OS/2 

; suspend Display Thread 
; transfer to OS/2 


push fhandle 

call DOSCLOSE 

push 1 

push 0 

call DOSEXIT 

dumpo: 

push stderr 

push ds 

push dx 

push cx 

push ds 

push offset DGROUP:status 
call DOSWRITE 

push 1 

push 1 

call DOSEXIT 

dump endp 


? close the input file 
? transfer to OS/2 

; terminate all threads 
; return code 0 for success 
? final exit to OS/2 

; print error message... 

? standard error device handle 
? address of message 

; length of message 
; receives bytes written 

; transfer to OS/2 

? terminate all threads 
; return code <>0 for error 
? final exit to OS/2 


? this thread performs 
? the file I/O, alternating 
; between the two buffers 

; fill buffer #1 
? handle for input file 
; address of buffer #1 

; record length requested 
; receives bytes read 


? signal buffer 1 has data 
mov si,offset DGROUP:BuflEmptySem 

mov di,offset DGROUP:BuflFullSem 

call SemFlip 

push ds ; wait until buffer 2 empty 

push offset DGROUP:Buf2EmptySem 

push -1 

push -1 

call DOSSEMWAIT 


DiskThread proc far 


push fhandle 

push ds 

push offset DGROUP:Buf1 
push recsize 

push ds 

push offset DGROUP: BuflLen 

call DOSREAD 


push fhandle 

push ds 

push offset DGROUP:Buf2 
push recsize 

push ds 


? fill buffer #2 
; handle for input file 
; address of buffer #1 

? record length requested 
; receives bytes read 
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push offset DGROUP:Buf2Len 

call DOSREAD 

? signal buffer 2 has data 
mov si,offset DGROUP:Buf2EmptySem 

mov di,offset DGROUP:Buf2FullSem 

call SemFlip 

push ds ? wait until buffer 1 empty 

push offset DGROUP:BuflEmptySem 

push -1 

push -1 

call DOSSEMWAIT 

jrop DiskThread ; do it again... 

DiskThread endp 


DisplayThread proc far ; formats and displays disk 

; data, alternating between 
? the two disk buffers 



push 

ds 

; wait until buffer #1 full 


push 

offset DGROUP:BuflFullSem 


push 

-1 



push 

-1 



call 

DOSSEMWAIT 



mov 

si,offset DGROUP:Buf1 

; display buffer 1 


mov 

cx,BuflLen 


call 

DumpRec 

? signal buffer #1 is emptied 


mov 

si,offset DGROUP:BuflFullSem 


mov 

di,offset DGROUP:BuflEmptySem 


call 

SemFlip 



push 

ds 

? wait until buffer #2 full 


push 

offset DGROUP:Buf2FullSem 


push 

-1 



push 

-1 



call 

DOSSEMWAIT 



mov 

si,offset DGROUP:Buf2 

? display buffer 2 


mov 

cx,Buf2Len 


call 

DumpRec 

? signal buffer #2 is emptied 


mov 

si,offset DGROUP:Buf2FullSem 


mov 

di,offset DGROUP:Buf2EmptySem 


call 

SemFlip 



jrop 

DisplayThread 

; do it again... 

DisplayThread endp 


SemFlip 

proc 

near 

? Flip status of two 
? semaphores atomically 


call 

DOSENTERCRITSEC 

? protect this code sequence 


push 

ds 

; set semaphore #1 


push 

si 



call 

DOSSEMSET 



push 

ds 

; clear semaphore 12 


push 

di 



call 

DOSSEMCLEAR 



call 

ret 

DOSEXITCRITSEC 

; let other threads run again 

SemFlip 

endp 



DumpRec 

proc 

near 

; formats and displays 
; contents of buffer 
; DS:SI = buffer, CX - length 


or 

cx,cx 

? anything to format? 


jnz 

DumpRec1 

; yes, continue 


continued 
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push dn 

push or runt OOROUPIKxltSom 

call D08B8MCLKAR 

pu«h 0 

punh 0 

call DO0BXZT 

DuiupMoi' I l 

rilptr,07fh 

)mr. I)umpRoc2 

|»unh stdout 

push ds 

push offset DGROUP:heading 

push heading_len 

push ds 

push offset DGROUP:status 

call DOSWRITE 

DumpRec2: 

push cx 

mov di,offset output 

mov cx, output__len-2 

mov al,blank 

rep stosb 

mov di,offset output 

mov ax,filptr 

call w2hex 

pop cx 

mov bx,0 

DumpRec3: 

mov al,[si+bx] 

mov di,offset outputb 

mov byte ptr [di+bx] 

cmp al,blank 

jb DumpRec4 

cmp al,7eh 

ja DumpRec4 

mov [di+bx],al 

DumpRec4: 

mov di,offset outputa 

add di,bx 

add di,bx 

add di,bx 

call b2hex 

inc bx 

loop DumpRec3 


push stdout 

push ds 

push offset DGROUP:output 

push output_len 

push ds 

push offset DGROUP:status 

call DOSWRITE 

add word ptr filptr,recs 

ret 

DumpRec endp 


argc proc near 

enter 4,0 

envseg equ [ lop—2 ] 

cmdoffs equ [bp-4] 

push es 

push bx 

push cx 


; no, clear exit semaphore 
; (releasing wait condition 
; for main thread) 

7 and terminate this thread 


7 time for a heading? 

; if 128 byte boundary 
7 no,jump 

? standard output device handle 
? address of heading text 

; length of heading 
? receives bytes written 


7 format record data... 

; save record length 

7 first clear output area 


? convert current file offset 
7 to ASCII for output 


7 get back record length 
? initialize record pointer 

? fetch next byte from buffer 

? store ASCII version of character 
? calculate output string address 
? if not alphanumeric 
? just print a dot. 

? jump, not alphanumeric. 

? jump, not alphanumeric. 

? else store ASCII character. 

7 now convert binary byte 
? to hex ASCII equivalent 
7 calc, position in output string 
? base addr + (offset*3) 

7 convert data in AL to hex 
? ASCII and store into output 

7 bump data pointer and loop 
? until entire record converted 

7 now display formatted data 
? standard output device handle 
? address of text 

7 length of text 

? receives bytes written 


7 update file pointer 
7 return to caller 


? count command line arguments 
; returns count in AX 

? make room for local variables 
; and give them names... 

? environment segment 
7 command line offset 

? save original ES,BX, and CX 
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push 

ss 


lea 

ax,envseg 


push 

ax 


push 

ss 


lea 

ax,cmdoffs 


push 

ax 


call 

DOSGETENV 


or 

ax, ax 


mov 

ax, 1 


jnz 

argc3 


mov 

es,envseg 


mov 

bx,cmdoffs 

argcO: 

inc 

bx 


cmp 

byte ptr es:[bx],0 


jne 

argcO 

argcl: 

mov 

cx, -1 

argc2: 

inc 

bx 


cmp 

byte ptr es:[bx],0 


je 

argc3 


cmp 

byte ptr es:[bx],blank 


je 

argcl 


cmp 

byte ptr es:[bx],tab 


je 

argcl 


jcxz 

argc2 


inc 

ax 


not 

cx 


jmp 

argc2 

argc3: 

pop 

cx 


pop 

bx 


pop 

leave 

ret 

es 

argc 

endp 


argv 

proc 

near 


enter 

4,0 

push 

cx 

push 

di 

push 

ax 

push 

ss 

lea 

ax,envseg 

push 

ax 

push 

ss 

lea 

ax,cmdoffs 

push 

ax 

call 

DOSGETENV 

or 

ax, ax 

pop 

ax 

jnz 

argv7 

mov 

es,envseg 

mov 

bx,cmdoffs 

or 

ax, ax 

jz 

argv8 

argvO: inc 

bx 

cmp 

byte ptr es:[bx],0 

jne 

argvO 


; get selector for environment 
; and offset of command line 


? transfer to OS/2 
; check operation status 
? force argc >= 1 
; inexplicable failure 

? set ES:BX = command line 


? ignore useless first field 


set flag = outside argument 

point to next character 

exit if null byte 

outside argument if ASCII blank 

outside argument if ASCII tab 

otherwise not blank or tab # 
jump if already inside argument 

else found argument, count it 
set flag * inside argument 
and look at next character 

restore original BX, CX, ES 


? discard local variables 
? return AX * argument count 


; get address and length 
; of command line arguments 
; call with AX = arg. no. 

; return ES:BX = address of 
; argument string, CX « length 

? make room for local variables 

? save original CX and DI 


? save argument number 

? get selector for environment 
; and offset of command line 


; transfer to OS/2 
; test operation status 
; restore argument number 
? jump if DOSGETENV failed 

; set ES:BX = command line 


? is requested argument-O? 

? yes, jump to get program name 

; scan off first field 


continued 
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xor 

ah, ah 


• 

9 

initialize argument counter 

argvl: 

mov 

cx,-l 


# 

set flag * outside argument 

argv2: 

inc 

bx 


9 

point to next character 


cmp 

byte ptr 

es:[bx],0 




je 

argv7 


9 

exit if null byte 


cmp 

byte ptr 

es:[bx],blank 




je 

argvl 


• 

9 

outside argument if ASCII blank 


cmp 

byte ptr 

es:[bx],tab 




je 

argvl 


9 

outside argument if ASCII tab 





9 

if not blank or tab... 


jcxz 

argv 2 


9 

jump if already inside argument 


inc 

ah 


9 

else count arguments found 


cmp 

ah, al 


• 

9 

is this the one we need? 


je 

argv 4 


9 

yes, go find its length 


not 

cx 


9 

no, set flag = inside argument 


jn>P 

argv2 


9 

and look at next character 

argv4: 




9 

found desired argument, now 





9 

determine its length... 


mov 

ax, bx 


9 

save param. starting address 

argv5: 

inc 

bx 


9 

point to next character 


cmp 

byte ptr 

es:[bx],0 




je 

argv 6 


9 

found end if null byte 


cmp 

byte ptr 

es:[bx],blank 




je 

argv6 


9 

found end if ASCII blank 


cmp 

byte ptr 

es:[bx],tab 




jne 

argv 5 


f 

9 

found end if ASCII tab 

argv6 : 

xchg 

bx, ax 


; 

set ES:BX - argument address 


sub 

ax,bx 


; 

and AX - argument length 


jmp 

argvx 


? 

return to caller 

nrgv7: 

xor 

ax, ax 


; 

set AX ■ 0, argument not found 


ji»P 

argvx 


t 

return to caller 

orgvB: 




t 

special handling for argv=0 


xor 

di ,di 


i 

find the program name'by 


xor 

al, al 


i 

first skipping over all the 


mov 

cx, -1 


! 

environment variables... 


cld 





argv9: 

repne 

scasb 


t 

scan for double null (can't use 


scasb 



; 

(SCASW since might be odd addr.) 


jne 

argv 9 


? 

loop if it was a single null 


mov 

bx, di 


? 

save program name address 


mov 

cx, -1 


S 

now find its length... 


repne 

scasb 


S 

scan for another null byte 


not 

cx 


i 

convert CX to length 


dec 

cx 





mov 

ax,cx 


• 

return length in AX 

argvx: 




• 

common exit point 


pop 

di 


t 

restore original CX and DI 


pop 

cx 





leave 



* 

discard stack frame 


ret 




return to caller 

argv 

endp 





w2hex 

proc 

near 


$ 

convert word to hex ASCII 





• 

i 

call with AX«binary value 





t 

DI=addr to store string 





i 

returns AX, DI destroyed 


push 

ax 





mov 

al, ah 





call 

b2hex 


; 

convert upper byte 


pop 

ax 





call 

b2hex 


; 

convert lower byte 


ret 



i 

back to caller 

w2hex 

endp 





b2hex 

proc 

near 


• 

t 

convert byte to hex ASCII 





; 

call with AL^binary value 





; 

DI=addr to store string 





# 

returns AX, DI destroyed 


push 

cx 


• 

save CX for later 


sub 

ah, ah 


; 

clear upper byte 
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mov 

cl,16 




div 

cl 

? 

divide binary data by 16 


call 

ascii 

t 

the quotient becomes the first 


stosb 


! 

ASCII character 


mov 

al, ah 




call 

ascii 

; 

the remainder becomes the 


stosb 


; 

second ASCII character 


pop 

cx 

t 

restore contents of CX 


ret 




b2hex 

endp 




ascii 

proc 

near 

t 

convert value 0-0FH in AL 




t 

into a "hex ASCII" character 


add 

al,*0' 




cmp 

al, '9 1 




jle 

ascii2 

; 

jump if in range 0-9, 


add 

al,' A'-'9 1 -1 

; 

offset it to range A-F, 

ascii2: 

ret 


S 

return ASCII char, in AL. 


ascii endp 


TEXT ends 

end dump 


BPSIM.C complements "Back-Propagation,” by William P. Jones and Josiah 
Hoskins, BYTE, October, 1987, page 155. 


7* 

* title: 

* author: 

* date: 

* 

* purpose: 

* 

* 

* description: 

* 

* 

* 

* 

* 

* 


bpsim.c 

Josiah C. Hoskins 
June 1987 

backpropagation learning rule neural net simulator 
for the tabula rasa Little Red Riding Hood example 

Bpsim provides an implementation of a neural network 
containing a single hidden layer which uses the 
generalized backpropagation delta rule for learning. 

A simple user interface is supplied for experimenting 
with a neural network solution to the Little Red Riding 
Hood example described in the text. 


In addition, bpsim contains some useful building blocks 
for further experimentation with single layer neural 
networks. The data structure which describes the general 
processing unit allows one to easily investigate different 
activation (output) and/or error functions. The utility 
function createlink can be used to create links between 
any two units by supplying your own create_in__out_links 
function. The flexibility of creating units and links 
to your specifications allows one to modify the code 
to tune the network architecture to problems of interest. 


There are some parameters that perhaps need some 
explanation. You will notice that the target values are 
either 0.1 or 0.9 (corresponding to the binary values 
0 or 1). With the sigmoidal function used in out_f the 
weights become very large if 0 and 1 are used as targets. 
The 0N_T0LERANCE value is used as a criteria for an output 
value to be considered "on", i.e., close enough to the 
target of 0.9 to be considered 1. The learning_rate and 
momentum variables may be changed to vary the rate of 
learning, however, in general they each should be less 
than 1.0. 

Bpsim has been compiled using CI-C86 version 2.30 on an 
IBM-PC and the Sun C compiler on a Sun 3/160. 


* Note to compile and link on U*IX machines use: 

* cc -o bpsim bpsim.c -lm 

* 


* For other machines remember to link in the math library. 

* status: This program may be freely used, modified, and distributed 

* except for commercial purposes. 

* 


continued 
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* Copyright (c) 1987 Jdsiah C. Hoskins 

V 

^include <math.h> 

^include <stdio.h> 

H include <ctype.h> 

Idefine BUFSIZ M2 


Idefine FALSE 
jfdefine TRUE 
ffdefinn NUM IN 
tfdnfinn HUM MID 

Icinrln* mum out 

ddnfInn TnrXl 
(•Ini (tin MIAN till) 

* HUM I MM III |»I MV Mm 

Mi.I III* IN IM I»( X) 

M- I hi* HID HID(X) 
ff iIm I Inn OUT UID(X) 

Muf ilin TARGET INDEX(X) 

Mi-1 In. WOLF_PATTERN 
M< lino GRANDMAPATTERN 
Mm fine WOODCUT_PATTERN 

Idofine Patterns 

I define ERRORTOLERANCE 
#define ON_TOLERANCE 
Idefine NOTIFY 
Idefine DEFAULT_ITER 

struct unit { 
int uid; 
char *label? 
double output; 
double (*unit_out_f)()? 
double delta? 
double (*unit_delta_f)()? 
struct link *inlinks; 
struct link *outlinks? 

) *pu[TOTAL+l]? 

struct link ( 
char *label; 
double weight; 
double data; 
int from_unit? 
int tounit? 

struct link *next_inlink; 
struct link *next_outlink; 

); 

int iterations « DEFAULT_ITER? 

double learning_rate « 0.2; 
double momentum * 0.9? 
double pattern_err[PATTERNS]? 

/* 

* Input Patterns 

* {Big Ears, Big Eyes, Big Teeth, Kindly, 

* unit 0 unit 1 unit 2 unit 3 

V 


double 

input pat[PATTERNS*1][NUM IN] 

- ( 

(1.0, 

1.0, 1.0, 0.0, 0.0, 0.0), 

/* 

{0.0, 

1.0, 0.0, 1.0, 1.0, 0.0), 

/* 

(1.0, 

0.0, 0.0, 1.0, 0.0, 1.0), 

/* 

{0.0, 

0.0, 0.0, 0.0, 0.0, 0.0), 

/* 


)? 


number of input units */ 
number of hidden units */ 
number of output units */ 


number of input patterns */ 

a unit's output is on if > ON_TOLERENCE */ 
iterations per dot notification */ 


general processing unit */ 

integer uniquely identifying each unit */ 

activation level */ 

note output fen == activation fen*/ 

delta for unit */ 

ptr to function to calc delta */ 

for propagation */ 

for back propagation */ 

one extra for the bias unit */ 

link between two processing units */ 

connection or link weight */ 

used to hold the change in weights */ 

uid of from unit */ 

uid of to unit */ 


Wrinkled, Handsome) 
unit 4 unit 5 


Wolf */ 

Grandma */ 

Woodcutter */ 

Used for Recognize Mode */ 


0 

IIAEMI 
A /a 


3 /* 

7 /* 

(NUM IN + NUMHID + NUMOUT) 
(TOTAL) /* threshold unit */ 

indexes for processing units */ 
(X) 

(NUMIN + X) 

(NUMIN + NUMHID + X) 

(X - (NUM IN + NUMJilD) ) 

0 
1 
2 

3 /* 

0.01 

0.8 /* 

10 /* 

250 

/* 

/* 

/* 

/* 

/* 

/* 

/* 

/* 

/* 

/* 

/* 

/* 

/* 

/* 


/* 

* Target Patterns 

* (Scream, Run Away, Look for Woodcutter, Approach, Kiss on Cheek, 

* Offer Food, Flirt with) 

V 

double target_pat(PATTERNS][NUMOUT] * { 

{0.9, 0.9, 0.9, 0.1, 0.1, 0.1, 0.1), /* response to Wolf */ 

{0.1, 0.1, 0.1, 0.9, 0.9, 0.9, 0.1), /* response to Grandma */ 

{0.1, 0.1, 0.1, 0.9, 0.1, 0.9, 0.9), /a response to Woodcutter */ 

); 


/* 

* function declarations 

V 
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void print_header(); 

char get_command(); 

double out_f(), deltafout(), delta_f_hid(), random(), pattern_error(); 


main() 

{ 

char ch; 

extern struct unit *pu[]? 

print_header(); 
create_processing_units(pu); 
create_in_out_links(pu); 
for (?;) { 

ch = get_command("\nEnter Command (Learn, Recognize, Quit) => ”); 
switch (ch) ( 
case *1': 
case 'L': 

printf("\n\tLEARN MODE\n\n"); 
learn(pu); 
break; 
case 'r': 
case * R': 

printf("\n\tRECOGNIZE MODE\n\n")? 
recognize(pu); 
break; 
case •q•: 
case 'Q': 
exit(l) ; 
break; 
default: 

fprintf(stderr, "Invalid Command\n"); 
break; 

) 

) 

) 


void 

printheader() 

( 

printf("%s%s%s", 

"\n\tBPSIM — Back Propagation Learning Rule Neural Net Simulator\n", 
"\t\t for the tabula rasa Little Red Riding Hood example.\n\n", 

M \t\t Written by Josiah C. Hoskins\n"); 


/* 

* create input, hidden, output units (and threshold or bias unit) 

V 

create_processing_units(pu) 
struct unit *pu(); 

( 

int id; /* processing unit index */ 

struct unit *create_unit(); 

for (id - IN__UID(0); id < IN UID(NUM_IN) ; id++) 

pufid] * createunit(id, "input", 0.0, NULL, 0.0, NULL); 
for (id * HIDJJID(O); id < HID_UID(NUM_HID); id++) 

pu(id) - createunit(id, "hidden", 0.0, outf, 0.0, deltafhid); 
for (id = OUTUID(O); id < OUT_UID(NUM_OUT); id++) 

- pu(id] * create_unit(id, "output", 0.0, out_f, 0.0, deltafout); 
pu (BIAS__UID) » create_unit (BIAS_UID, "bias", 1.0, NULL, 0.0, NULL); 


/* 

* create links - fully connected for each layer 

* note: the bias unit has one link to ea hid and out unit 

V 

create_in_out_links(pu) 
struct unit *pu[); 

( 

int i, j? /* i ■■ to and j == from unit id's */ 

struct link *create_link(); 

/* fully connected units */ 

for (i * HID_UID(0); i < HID_UID(NUM_HID) ? i-»-+) ( /* links to hidden */ 
pu(BIAS_UID]->outlinks = 

pu(i)->inlinks - create_link(pu(i)->inlinks, i, 

pu[BIAS_UID]->out links, BIAS__UID, 

(char MNULL, 
random(), 0.0)? 

continued 
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for (j = IN_UID(0); j < IN UID(NUM IN); j++) /* from input units */ 
pu[j]->outlinks « 

pu[i]->inlinks - croato 1ink(pu[i]->inlinks, i, pu[ j ]->outlinks, j, 

(char *)NULL, random(), 0.0); 

) 

for (i - OUT UID(O); i • OUT UID(NUM OUT)? i++) ( /* links to output */ 

pu f DIAS Uin)->out IInkn 

I»m| k ] inllnki! croatG_link(pu[i]->inlinks, i, 

pu(BIAS_UID]->outlinks, BIAS_UID, 
(char *)NULL, random(), 0.0); 

fni j| MM) III D(0) ; j < HID_UID(NUM_HID) ? j++) /* from hidden units */ 
pu| i) -out 1 inks - 

I mi | t ) *inlinks « create_link(pu(i)->inlinks, i, pu[ j] ->outlinks, j, 

(char *)NULL, random(), 0.0); 


) 

/* 

* return a random number bet 0.0 and 1.0 

V 

double 
random() 

( 

return((rand() % 32727) / 32737.0); 

) 


/* 

* the next two functions are general utility functions to create units 

* and create links 

V 

struct unit * 

create_unit(uid, label, output, out_f, delta, delta_f) 

int uid; 

char *label; 

double output, delta; 

double (*out_f)(), (*delta_f)(); 

( 

struct unit *unitptr; 

if (!(unitptr = (struct unit *)malloc(sizeof(struct unit)))) { 
fprintf (stderr, "create unit: not enough memory\n"); 
exit(1); 

) 

/* initialize unit data */ 
unitptr->uid = uid; 
unitptr->label « label; 
unitptr->output = output; 

unitptr->unit_out_f = outf; /* ptr to output fen */ 
unitptr->delta «= delta; 
unitptr->unit_delta_f = delta_f; 
return (unitptr); 


struct link * 

create_link(start_inlist, to_uid, start outlist, from_uid, label, wt, data) 

struct" link *start_inlist, *start_outlTst; 

int to_uid, from_uid; 

char * label; 

double wt, data; 

( 

struct link *linkptr; 

if (!(linkptr = (struct link *)malloc(sizeof(struct link)))) { 
fprintf(stderr, "create_link: not enough memory\n"); 
exit(1); 

) 

/* initialize link data */ 
linkptr->label «= label; 
linkptr->from_unit «= from_uid; 
linkptr->to unit = touid; 
linkptr->welght = wt; 
linkptr->data ■ data; 
linkptr->next_inlink = startinlist; 
linkptr->next_outlink * start_outlist; 
return(linkptr); 


char 

get_ command(s) 
char *s; 

( 

char command( BUFSIZ); 
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fputs(s, stdout); 
fflush(stdin); fflush(stdout); 

(void)fgets(command, BUFSIZ, stdin); 

return((command(0])); /* return 1st letter of command */ 


learn(pu) 

struct unit *pu[); 

( 

register i, temp; 

char tempstr[BUFSIZ); 

extern int iterations; 

extern double learningrate, momentum; 

static char prompt(] = "Enter # iterations (default is 250) => ”; 
static char quotel[) - "Perhaps, Little Red Riding Hood ”; 
static char quote2[] = "should do more learning.\n”; 

printf(prompt); 

fflush(stdin); fflush(stdout); 
gets(tempstr); 
if (temp = atoi(tempstr)) 
iterations *= temp; 

printf(”\nLearning "); 
for (i ■ 0; i < iterations; i++) ( 
if ((i % NOTIFY) — 0) { 
printf(”.”); 
fflush(stdout); 

) 

bp_learn(pu, (i == iterations-2 || i — iterations-1 || i == iterations)); 

) 

printf(” Done\n\n"); 

printf ("Error for Wolf pattern *= \t%lf\n", pattern_err[0]); 
printf("Error for Grandma pattern ■ \t%lf\n", pattern_err[1]); 
printf("Error for Woodcutter pattern « \t%lf\n”, pattern_err[2]); 
if (pattern_err[WOLF_PATTERN) > ERRORTOLERANCE) { 

printf(”\nl don't know the Wolf very well.\n%s%s”, quotel, quote2); 

) else if (pattern_err[GRANDMA_PATTERN) > ERROR_TOLERANCE) { 

printf(”\nl don*t know Grandma very well.\n%s%s”, quotel, quote2); 

) else if (pattern_err[WOODCUT_PATTERN) > ERROR_TOLERANCE) ( 

printf(”\nl don't know Mr. Woodcutter very well.\n%s%s", quotel, quote2); 

) else ( 

printf(”\nl feel pretty smart, now.\n"); 

) 


/* 

* back propagation learning 

V 

bp__learn(pu, save error) 
struct unit *pu(); 
int save_error; 

( 

static int count - 0; 

static int pattern - 0; 

extern double pattern__err( PATTERNS); 

init_input_units(pu, pattern); /* initialize input pattern to learn */ 
propagate(pu); /* calc outputs to check versus targets */ 

if (saveerror) 

pattern_err[pattern) ■= pattern error(pattern, pu) ; 
bpadjustweights(pattern, pu); 
if (pattern < PATTERNS - 1) 
pattern+t; 
else 

pattern - 0; 
count++; 


/* 

* initialize the input units with a specific input pattern to learn 

V 

initinputunits(pu, pattern) 
struct unit *pu[]; 
int pattern; 

( 

int id; 

for (id - IN_UID(0); id < IN_UID(NUM_IN); id++) 
pu(id)->output « input_pat(pattern)(id]; 

continued 
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/* 

* calculate the activation level of each unit 

V 

propagate(pu) 
struct unit *pu[]? 

( 

int id? 

for (id = HID__UID(0) ? id < HID_UID(NUM_HID); id++) 
(*(pu(id]->unit_out_f))(pu[id], pu)? 
for (id = OUT_UID(0) ? id < OUT_UID(NUM_OUT) ; id++) 
(*(pu[id]->unit_out_f))(pu[id], pu)? 


/* 

* function to calculate the activation or output of units 

V 

double 

out_f(puptr, pu) 

struct unit *pu_ptr, *pu[]? 

( 

double sum - 0.0, exp(); 
struct link *tmp_ptr? 
tmpptr « pu_ptr->inlinks; 
while (tmp_ptr) { 

/* sum up (outputs from inlinks times weights on the inlinks) */ 
sum += pu(tmp_ptr->from_unit]->output * tmp_ptr->weight? 
tmp ptr =» tmp_ptr->next_inlink? 

) 

pu_ptr->output * 1.0/(1.0 + exp(-sum))? 


/* 

* half of the sum of the squares of the errors of the 

* output versus target values 

V 

double 

patternerror(pat_num, pu) 

int pat_num; /* pattern number */ 

struct unit *pu(]; 

( 

int i; 

double temp, sum = 0.0; 

for (i « OUT_UID(0); i < OUTUID(NUMOUT)? i++) ( 

temp = target_pat [pat_num] [TARGET__INDEX (i) ] - pu[i)->output; 
sum +* temp * temp; 

) 

return (sum/2.0)? 


bp_adjust_weights(pat_num, pu) 

int pat_num; /* pattern number */ 

struct unit *pu[); 

{ 

int i? /* processing units id */ 

double tempi, temp2, delta, error sum? 

struct link *inlink_ptr, *outlink_ptr? 

/* calc deltas */ 

for (i = OUT__UID(0) ? i < OUT_UID(NUM_OUT) ? i++) /* for each output unit */ 

(*(Pu[i)->unit_delta_f))(pu, i, pat_num)? /* calc delta */ 
for (i =■ HID_UID(0); i < HIDJJID(NUM_HID)? i++) /* for each hidden unit */ 

(*(P U Ci]~>unit_delta_f))(pu, i)? /* calc delta */ 

/* calculate weights */ 

for (i - OUT_UID(0); i < 0UT_UID(NUM_0UT)? i++) { /* for output units */ 

inlinkptr « pu(i]->inlinks; 

while (inlink_ptr) ( /* for each inlink to output unit */ 

tempi = learning_rate * pu(i]->delta * 
pu(inlink_ptr->fromunit]->output? 
temp2 « momentum * inlink_ptr->data? 

iniink_ptr->data « tempi + temp2? /* new delta weight */ 
iniink_ptr->weight += inlink_ptr->data; /* new weight */ 

inlinkptr ■ inlink_ptr->next inlink? 

) 

) 

for (i * HIDJJID(O); i < HID_UID(NUM_HID) ? i++) ( /* for ea hid unit */ 
inlink_ptr - pu(i]->inlinks; 

while (inlinkptr) ( /* for each inlink to output unit */ 

tempi - learningrate * pu(i]->delta * 
pu (ini ink_ptr->from_unit) ->output; 
temp2 - momentum * inlink_ptr->data? 
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inlink_ptr->data = tempi + temp2; /* new delta weight */ 
inlink_ptr->weight += inlink_ptr->data; /* new weight */ 
inlink_ptr = inlink_ptr->next_inlink; 

> 

} 

) 


/* 

* calculate the delta for an output unit 

V 

double 

delta_f_out(pu, uid, pat_num) 
struct unit *pu[]? 
int uid, pat_num; 

( 

double tempi, temp2, delta; 

/* calc deltas */ 

tempi = (target_pat[patnum][TARGETINDEX(uid)] - pu[uid)->output); 
temp2 = (1.0 - pu[uid]->output); 

delta = tempi * pu(uid]->output * temp2; /* calc delta */ 
pu[uid)->delta *= delta; /* store delta to pass on */ 


/* 

* calculate the delta for a hidden unit 

V 

double 

delta_f_hid(pu, uid) 
struct unit *pu[); 
int uid; 

{ 

double tempi, temp2, delta, error_sum; 

struct link *inlink_ptr, *outlink_ptr? 

outlink_ptr « pu[uid]->outlinks; 
error__sum = 0.0? 
while (outlink_ptr) ( 

error_sum +« pu[outlink_ptr->to_unit)->delta * outlink_ptr->weight; 
outlink_ptr = outlink_ptr->next_outlink? 

) 

delta = pu[uid]->output * (1.0 - pu[uid]->output) * error_sum? 
pu(uid)->delta = delta; 


recognize(pu) 
struct unit *pu[]? 

{ 

int i? 

char tempstr[BUFSIZ]? 

static char *p[] = ("Big Ears?", "Big Eyes?", "Big Teeth?", 
"Kindly?\t", "Wrinkled?", "Handsome?")? 

for (i *= 0; i < NUM_IN? i++) ( 
printf("%s\t(y/n) ", p[i])? 
fflush(stdin)? fflush(stdout)? 
fgets(tempstr, BUFSIZ, stdin)? 
if (tempstr[0] — *Y* || tempstr[0] « ‘y') 
input_pat(PATTERNS)(i) - 1.0? 
else 

inputpatfPATTERNS)(i) = 0.0; 

) 

init_input_units(pu, PATTERNS); 

propagate(pu)? 

print_behaviour(pu)? 


printbehaviour(pu) 
struct unit *pu[); 

< 

int id, count = 0? 
static char *behaviour[] = ( 

"Screams", "Runs Away", "Looks for Woodcutter", "Approaches", 
"Kisses on Cheek", "Offers Food", "Flirts with Woodcutter" ); 


continued 
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printf("\nLittle Red Riding Hood: \n"); 

for (id = OUT__UID(0) ; id < OUT UID(NUM OUT) ; id++) { /* links to out units */ 
if (pu[id]->output > ONTOLERANCE) 
printf("\t%s\n", behaviour[count]); 
count++; 

) 

printf("\n")? 


SIEVE.CPP accompanies "Advantage C++ and Guidelines C++," by Mark 
Mallett, BYTE, October, 1987, page 229. 


This file contains the two files used for the "sieve" C++ benchmark. 
You'll have to separate them. They are 

sv_cpp.h The include file used to re-implement all the 

arithmetic operators. 

sieve.cpp The sieve program, slightly modified to: 

a) reference the "sv_cpp.h" file 

b) change the number of loops from 10 to 100. 


- Beginning of svcpp.h - 

/* SV_CPP.H - new "int" class for the seive benchmark for C++ */ 

class INT { 
int val; 
public: 

INT( int i ) { val « i; ) 

INT()() 

/* -INT(M) */ 

int operator* (int t2); 
int operator+ (int t2)? 
int operator- (int t2); 
int operator+= (int t2); 
int operator++ ()? 
int operator*:* (int t2); 

operator int()? 


}; 


/* Include the following statement to prevent inline substitution of 
code implementing arithmetic operations; enclose it in comments 
to make that code inline. */ 
jddefine inline 

/* Likewise, include the following in comments to prevent declaring the 
second term of each operator as a register variable */ 

/* fldefine register */ 

inline int INT :: operator* ( register int t2 ) 

( 

return( val « t2 ) ? 

) 

inline int INT :: operator+ ( register int t2 ) 

{ 

return( val + t2 )? 

) 

inline int INT :: operator- ( register int t2 ) 

{ 

return( val - t2 ); 

) 

inline int INT :: operator+* ( register int t2 ) 

( 

return( val +* t2 )? 

) 

inline int INT :: operator++ ( ) 

< 

return( val++ )? 

I 

inline int INT :: operator*:* ( register int t2 ) 

( 

return( val <- t2 )? 

) 
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inline int INT :: operator int ( ) 

{ 

return( val ); 

) 


/* Now for the trick.. */ 
fidefine int INT 

- End of sv_cpp.h - 

t 

- Beginning of sieve.cpp —- 


/* 

Eratosthenes Sieve Prime Number Program in from BYTE January 1983 

V 


#include ”sv_cpp.h" 

K define TRUE 1 
^define FALSE 0 
fldefine size 8190 


char flags [size + 1]; 
main() 

( 

int i, prime, k, count, iter; 


/* 


printf ("100 iterations\n")? 
for (iter = 1; iter <= 100; iter++) 
( 

count = 0; 

for (i * 0; i <= size; i++) 
flags [i] = TRUE; 
for (i - 0; i <= size; i++) 

{ 

if (flags [i]) 

{ 


/* do program 100 times */ 

/* prime counter */ 

/* set all flags true */ 


/* found a prime */ 


prime = i + i + 3; /* twice index + 3 */ 

printf (”\n%d", prime); */ 

for (k - i + prime; k <« size; k+- prime) 

flags [k] = FALSE; /* kill all multiple */ 
count++; /* primes found */ 


) 

) 

) 

printf ( M \007%d primes.\n", count); /* primes found on 100th pass */ 


End of sieve.cpp 


CPLUS.SRC accompanies ”Advantage C++ and Guidelines C++,” by Mark Mallett, 
BYTE, October, 1987, page 229. 


/* score_c.h - Definitions for classes related to the "score” program 
written for the Byte C++ Review 

May 1987 Mark E. Mallett 

V 

#ifndef NULL 

Jfdefine NULL (char *)0 
Sendif 


/* This 

header file declares 

the following 

classes: */ 

class 

SCORE ITEM; 


class 

REST; 

// 

Derived from SCORE ITEM 

class 

NOTE; 

// 

Derived from SCORE ITEM 

class 

CHORD^- 

// 

Derived from SCORE_ITEM 

class 

SEQUENCE; 

// 

Relates to SCORE ITEM 

class 

SEQITER; 

// 

Allows following a SEQUENCE 


onum NOTEVAL ( C, Csh, D, Dsh, E, F, Fsh, G, Gsh, A, Ash, B ); 
istreamfi. oporator>> ( istreami, N0TEVAL& ); 


continued 
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clflnn SCORE__ITEM // 

{ 

int duration? // 

SCOREITEM* next; // 

friend class SEQUENCE; 
friend class SEQ_ITER? 
friend istreamS operator>> ( istreamS, 
public: 

SCORE_ITEM( int d = 3 )( duration = d? 
-SCORE__ITEM () ( ) 


Base class for all score items 

How long this item persists 
Next SCORE_ITEM in the sequence 

SCORE_ITEMS )? 

) 


int dur() { return duration; ) // Retrieves duration value 

virtual void play(); // Plays a score item 

>? 


class REST : public SCOREITEM 

( 

public: 

REST( int d = 3 ) : ( d ) {) 

void play()? 

); 


// Musical rest— marks a place 


class NOTE : public SCOREITEM 
{ 

NOTEVAL noteval; // Value of the note 

friend istreamS operator>> ( istreamS, NOTES ); 
public: 

NOTE( NOTEVAL n = C, int d = 3 ) : ( d ) { noteval = n? ) 

-NOTE()()? 

void play(); 

>? 


class CHORD: public SCOREITEM 

{ 

int notemask; // Notes that make up this chord 

friend istreamS operator» ( istreamS, CHORDS ); 
public: 

CHORD( int n * 0 , int d = 3 ) : ( d ) ( notemask = n; ) 

-CHORD()(} 

void play(); 

); 


Class SEQUENCE 
{ 

SCORE_ITEM* 

SCOREITEM* 

SEQUENCES 

< if ( 


// Class allowing sequence operations. 


item? // Points to item 

last? // Points to last item 

append( SCOREITEM *si ) 

(SCORE_ITEM *)NULL ) item « last - si; 

last « si? si->next ® (SCORE_ITEM *)NULL; 


item 

last->next - si; 
return *this? ) 
friend class SEQITER? 
public: 

SEQUENCE () ( item *= last = (SCORE_ITEM *)NULL? ) 
SEQUENCE( SCORE__ITEMS si ) { item * last = Ssi? 


-SEQUENCE()() 
SEQUENCES operator® 
SEQUENCES operator® 

{ item = s2.item; 


) 


last ■ Ssi; return *this? } 


( SCORE_ITEMS si ) ( item 

( SEQUENCES s2 ) 

last «= s2. last ? return *this; ) 

SEQUENCES operators- ( SCORE_ITEMS si ) ( return append ( Ssi )? 
SEQUENCES operator*** ( SCORE_ITEMS si ) { return append( Ssi ) 
SEQUENCES operator*® ( SCORE_ITEM* si ) { return append( si )? 
) • 


class SEQITER 

( 

SEQUENCE* seq; 

SCORE__ITEM* si; 
public: 

SEQ_ITER( SEQUENCES sq ){ seq 
-SEQ_ITER()() 

SCORE_ITEM* operator()(); 

)? 


// To follow a sequence with 

// Ptr to song header 
// Ptr to current item 

Ssq; si * sq.item? } 

// Retrieve next one 


24 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER. 1987 







October 


/* score c.c++ - Support functions for classes related to the "score” program 
written for the Byte C++ Review 

May 1987 Mark E. Mallett 


V . 

#include <stream.h> 

#include <string.h> 

#include "scorec.h" 


/* Table of correlations between note names and noteval mnemonics */ 
static struct ( NOTEVAL nval; char* nname; ) Nvtbl[13] - { 


( 

C, 

" C " ) 

{ 

Csh, 

"Csh" 

( 

D, 

" D" ) 

( 

Dsh, 

"Dsh" 

{ 

E, 

"E" ) 

{ 

F, 

" F" ) 

{ 

Fsh, 

"Fsh" 

{ 


"G" } 

( 

Gsh, 

"Gsh" 

{ 

A, 

"A" ) 

{ 

Ash, 

"Ash" 

( 

B, 

"B" ) 


" BAD" 

) 


void SCORE_ITEM :: play() // play for generic score_items 

cout << "generic item: duration 55 " « dec (duration, 3) « "\n"; 


void REST :: play() 

cout « "rest: duration*" « dec(dur(),3) « "\n"? 

) 


void NOTE :: play() 

{ 

int i ; 

for( i = 0; i < 12; ++i ) 

if ( noteval ■« Nvtbl(i].nval ) 
break; 

cout << "note: duration*" << dec(dur(),3) 

<< " value: " « Nvtbl[i].nname « "\n"; 

) 


void CHORD :: play() 
{ 



int 

i; 


int 

nval; 

cout 

<< "chord: 

duration*" « dec(dur(),3) « " value:" 

for ( 

nval = 0; 

nval < 12; ++nval ) 


if ( notemask & (1 << nval ) ) 


for( i * 0; i < 12; ++i ) 

if ( nval ** Nvtbl[i].nval ) 
break; 

cout « " " « Nvtbl(i].nname; 

) 

cout << "\n"; 

) 


:;C0RE_ITEM* SEQ^ITER :: operator()() 

•;C0RE_ITEM* tsi = si; // Copy of current ptr 

if ( si != (SCOREITEM *)NULL ) si - si -> next; 
return tsi; 

) 


istream& operator>> ( istream& s, NOTEVAL& n 

( 


continued 
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int i ; 

char namebuf[100]; 

s >> (char *) &namebuf[0]? // Input name 

for( i = 0 ; i < 12 ; ++i ) 

if ( stricmp( namebuf, Nvtbl(i].nname ) == 0 ) 
break; 

if ( i < 12 ) 

n = Nvtbl[i].nval? 

else 

cout << "Error: • ” « namebuf « ”• is not a note name\n"; 
return s; 

) 


istream& operator>> ( istream& s, SCORE_ITEM& si ) 

{ 

s » si.duration; 
return s; 

) 


istreamfc operator» ( istreara& s, N0TE& n ) 

{ 

s » (SCORE_ITEM& ) n; 
s » n.noteval; 
return s; 

) 


istreamfc operator» ( istream& s, CH0RD& c ) 

{ 

NOTEVAL nval; 
char ch; 


s » (SCORE_ITEM& ) c; 
c.notemask = 0; 
for( ; ? ) 

( 

s » (NOTEVAL &) nval; 
c.notemask |- (1 « nval); 
s >> ch; 

if ( ch == •; 1 ) 
break; 

s.putback( ch )? 

) 

return s; 

) 


// No notes 

// Input notenames until no comma 

// Get next note 

// Look for semi 
// Quit when found 

// Re-use the not-semi 


/* score.C++ - Test program for the "score” classes, 
written for the Byte C++ Review 

May 1987 Mark E. Mallett 


V 

#include <stream.h> 

H include <ctype.h> 

if include "score_c.h” 
void play( SEQUENCE& ); 


main() 

{ 

SEQUENCE songl; 

NOTE cl(5), c2(10); 

cl - C; 
c2 - G; 
songl • cl; 

songl *= songl + c2 + NOTE (Dsh, 7) ; 
songl +- NOTE(Ash); 
play( songl ); 
cout « "\n\n"? 


SEQUENCE song2; 
char c; 

cout << "Enter each element of the song in the following formats\n\n"; 
cout << "r dd to enter a rest\n”; 
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cout « "n dd note-name 
cout « M c dd note-name., 
cout << "p 
cout « "x 

for( ? ? ) 

( 

cout << "\n> "; 
cin » c? 

if ( isupper( c ) ) 
c = tolower( c )? 
if ( c == 'x* ) 
break; 

switch ( c ) 

{ 


to enter a note\n"; 
to enter a chord\n"; 
to play the song\n"; 
to finish\n"; 

// Loop until done 

// Issue prompt 
// Get key character 


// Process input 
// rest 


REST* rest = new REST 
cin » *rest; 
song2 +“ rest; 
cout « "rest entered\n' 
break; 


case ' n': // note 

NOTE* note - new NOTE; 
cin >> *note; 
song2 += note; 
cout << "note entered\n"; 
break; 


case *c': // chord 

CHORD* chord = new CHORD; 
cin » *chord; 
song2 += chord; 
cout « "chord entered\n"; 
break; 

case ’p': // Play 

play( song2 ); // Play it 

break; 

default: // Invalid 

cout << "« chr(c) « isn't valid.\n"; 
break; 

) 

) 

) 


void play( SEQUENCE &song ) // Routine to play a song 

SEQ_ITER nextseq(song); // Get an iterator for the song 

SCORE ITEM *siptr; 

while ( ( siptr « next_seq() ) != (SCORE_ITEM *)NULL ) 

siptr->play(); 

) 


*** end Score *** 


MINIPRES.LST is referenced in, "Mathematical Reasoning," by Leon Sterling, 
itYTE, October, 1987, page 177. 

/* Program 22.1 A program for solving equations 

solveequation(Equation,Unknown,Solution) ;- 

Solution is a solution to the equation Equation 
in the unknown Unknown. 

V 

op(40,xfx,\). 
op(50,xfx,*). 

solve_equation(A*B=0,X,Solution) : - 
♦ 

factorize(A*B,X,Factors\[)), 
removeduplicates(Factors,Factorsl), 
solve_factors(Factorsl,X,Solution). 

solve_equation(Equation,X,Solution) :- 
single_occurrence(X,Equation) , 

!, 
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position(X,Equation,[Side|Position]), 
maneuver_sides(Side,Equation,Equationl), 
isolate (Position, Equation!., Solution) . 

solveequation(Lhs=Rhs,X,Solution) :- 
is_polynomial(Lhs,X), 
ispolynomial(Rhs,X), 

i 

• I 

polynomial_normal_form(Lhs-Rhs,X,PolyForm), 
solve_polynomial_equation(PolyForm,X,Solution). 

solveequation(Equation,X,Solution) 
offenders(Equation,X,Offenders), 
multiple(Offenders), 

homogenize(Equation,X,Offenders,Equationl,XI), 
solve_equation(Equationl,XI,Solutionl), 
solve_equation(Solutionl,X,Solution). 

/* Program 22.1b Supporting code for the factorization method 

factorize(Product,Term,Factors) :- 

Factors is a difference-list of factors of Product 
containing Term. 


factorize(A*B,X,Factors\Rest) :- 

!,factorize(A,X,Factors\Factorsl), 
factorize(B,X,Factorsl\Rest). 
factorize(C,X,(C|Factors]\Factors) :- 
subterm(X,C), !. 

factorize(C,X,Factors\Factors). 

/* solvefactors(Factors,Unknown,Solution) :- 

Solution is a solution of the equation Factor^O in 
the Unknown for some Factor in the list of Factors. 


solve factors([Factor|Factors),X,Solution) :- 
solve_equation (Factor*=0, X, Solution) . 
solvefactors([Factor|Factors],X,Solution) :- 
solvefactors(Factors,X,Solution). 


/* Program 22.1c Supporting code for the Isolation method */ 

singleoccurrence(Subterm,Term) :- 
occurrence(Subterm,Term,1). 

maneuversides(1,Lhs = Rhs,Lhs = Rhs) !. 

maneuver_sides(2,Lhs = Rhs,Rhs = Lhs) !. 

isolate([N|Position),Equation,IsolatedEquation) :- 
isolax(N,Equation,Equationl), 
isolate(Position,Equationl,IsolatedEquation). 

isolate([],Equation,Equation). 


/* Axioms for Isolation */ 


isolax(1,-Lhs - Rhs,Lhs 

isolax(l,Terml+Term2 = 
isolax(2,Terml+Term2 - 

isolax(l,Terml-Term2 = 
isolax(2,Terml-Term2 ■ 

isolax(l,Terml*Term2 - 
Term2 \« 0. 

isolax(2,Terml*Term2 » 
Terml \« 0. 

isolax(l,Terml/Term2 « 
Tcrm2 \*» 0. 

isolax(2,Terml/Term2 « 
Rhs \= 0. 

isolax(l,Terml A Term2 « 
isolax(2,Terml A Term2 = 

isolax(l,sin(U) « V,u - 
isolax(l,sin(U) « V,U ■ 
isolax(l,cos(U) « V,U « 
isolax(1,cos(U) ■ V,U - 


- -Rhs). 



% 

Unary minus 

Rhs,Terml 

3 

Rhs-Term2). 

% 

Addition 

Rhs,Term2 

= 

Rhs-Terml). 

% 

Addition 

Rhs,Terml 

B 

Rhs+Term2). 

% 

Subtraction 

Rhs,Term2 

= 

Terml-Rhs). 

% 

Subtraction 

Rhs,Terml 

- 

Rhs/Term2) 

% 

Multiplication 

Rhs,Term2 

s 

Rhs/Terml) :- 

% 

Multiplication 

Rhs,Terml 


Rhs*Term2) :- 

% 

Division 

Rhs,Term2 

- 

Terml/Rhs) 

% 

Division 

Rhs,Terml 

s 

Rhs A (—Term2)). 

% 

Exponentiation $$$ 

Rhs,Term2 

SB 

log(base(Terml),Rhs)) 

• 

% Exponentiation 

arcsin(V)). 


% 

Sine 

180 - arcsin(V)). 

% 

Sine 

arccos(V)). 


% 

Cosine 

-arccos(V)) 

• 

% 

Cosine 


/* Program 22.Id Support code for Polynomial methods */ 
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is_polynomial(X,X) !. 

is_polynomial(Term,X) 

constant(Term),1. 
is_polynomial(Terml+Term2,X) 

!,ispolynomial(Terml,X), 
is_polynomial(Term2,X). 
is_polynom!al(Terml-Term2,X) 

!,is_polynomial(Terml,X), 
ispolynomial(Term2,X). 
is_polynomial(Terml*Term2,X) 

!,ispolynomial(Terml,X), 
ispolynomial(Term2,X). 
ispolynomial(Terml/Term2,X) 

!,ispolynomial(Terml,X), 
constant(Term2). 
ispolynomial(Term A N,X) 

!,naturalnumber(N),ispolynomial(Term,X). 

natural_number(N) integer(N),N >0,1. 

/* polynomial_normal_form(Expression,Term,PolyNormalForm) 

PolyNormalForm is the polynomial normal form of the 
Expression, which is a polynomial in Term. 

V 


polynomial_normal_form(Polynomial,X,NormalForm) :- 
polynomial_form(Polynomial,X,PolyForm), 
remove_zero_terms(PolyForm,NormalForm), !. 

polynomial_form(X,X,((1,1))). 
polynomial_form(X A N,X,((1,N))). 
polynomial form(Terml+Term2,X,PolyForm) 
polynomial_form(Terml,X,PolyForml), 
polynomial_form(Term2,X,PolyForm2), 
add_polynomials(PolyForml,PolyForm2,PolyForm). 
polynomial form(Terml-Term2,X,PolyForm) 
polynom!al__form (Terml, X, PolyForml) , 
polynomial_forra(Term2,X,PolyForm2), 

subtract_polynomials(PolyForml,PolyForm2,PolyForm). 
polynomial form(Terml*Term2,X,PolyForm) 
polynomIal_form(Terml,X,PolyForml), 
polynomial_form(Term2,X,PolyForm2), 

multiply_polynomials(PolyForml,PolyForm2,PolyForm). 
polynomial form(Term A N,X,PolyForm) !, 
polynom!al_form(Term,X,PolyForml), 
binomial(PolyForml,N,PolyForm). 
polynomial_forra(Term,X,((Term,0)]) 
free_of(X,Term), !. 

remove__zero_terms(((0,N) | Poly] ,Polyl) 

!, remove_zero_terms(Poly,Poly1). 
remove_zero_terms([(C,N)|Poly],[(C,N)|Polyl]) 

C \- 0, !, removezeroterms(Poly,Polyl). 
remove_zero_terms((),()). 

/* Polynomial manipulation routines */ 

/* add_polynomials(Polyl,Poly2,Poly) 

Poly is the sum of Polyl and Poly2, where 
Polyl, Poly2 and Poly are all in polynomial form. 


add_polynomials((],Poly,Poly) !. 

addpolynomials(Poly,(),Poly) !. 

add_polynomials(((Ai,Ni)|Polyl], [(Aj , Nj)|Poly2],[(Ai,Ni)|Poly]) 

Ni > Nj, !, addpolynomials(Polyl,((Aj,Nj)|Poly2],Poly). 
add_polynomials(((Ai,Ni)|Polyl],((Aj,Nj)|Poly2],((A,Ni)|Poly]) 

Ni Nj, !, A is Ai+Aj, add_polynomials(Polyl,Poly2,Poly). 

add_polynomials(((Ai,Ni)|Polyl],((Aj,Nj)|Poly2),((Aj,Nj)|Poly]) 

Ni < Nj, !, add_polynomials(((Ai,Ni)|Polyl],Poly2,Poly). 

/* subtract_polynomials(Polyl,Poly2,Poly) 

Poly is the difference of Polyl and Poly2, where 
Polyl, Poly2 and Poly are all in polynomial form. 


subtract_polynomials(Polyl,Poly2,Poly) 

multiplysingle(Poly2,(-1,0),Poly3), 
addpolynomials(Polyl,Poly3,Poly), !. 

/* multiply^single(Polyl,Monomial,Poly) 

Poly is the product of Polyl and Monomial, where 
Polyl, and Poly are in polynomial form, and Monomial 
has the form (C,N) denoting the monomial C*X A N. 


continued 
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multiply_single([(Cl,Nl)|Polyl],(C,N),[(C2,N2)|Poly)) 

C2 is C1*C, N2 is Nl+N, multiplysingle(Polyl,(C,N),Poly). 
multiply_single([],Factor, [)) . 

/* multiply_polynomials(Polyl,Poly2,Poly) 

Poly is the product of Polyl and Poly2, where 
Polyl, Poly2 and Poly are all in polynomial form. 


multiply_polynomials([(C,N)|Polyl),Poly2,Poly) 
multiply_single(Poly2,(C,N),Poly3), 
multiply_polynomials(Polyl,Poly2,Poly4), 
add_polynomials(Poly3,Poly4,Poly). 
multiply_polynomials([),?,())• 

binomial(Poly,1,Poly). 

/* solve_polynomial_equation(Equation,Unknown,Solution) 
Solution is a solution to the polynomial Equation 
in the unknown Unknown. 


solve_polynomial_equation(PolyEquation,X,X * -B/A) 
linear(PolyEquation), !, 
pad(PolyEquation,((A,1),(B,0))). 
solve_polynomial_equation(PolyEquation,X,Solution) :- 
quadratic(PolyEquation), !, 
pad(PolyEquation,[(A,2),(B,l),(C,0)]), 
discriminant(A,B,C,Discriminant), 
root(X,A,B,C,Discriminant,Solution). 

discriminant(A,B,C,D) D is B*B - 4*A*C. 

root(X,A,B,C,0,X= -B/(2*A)). 

root(X, A, B, C, D,X= (-B+sqrt(D))/(2*A)) D > 0. 

root(X,A,B,C,D,X- (-B-sqrt(D))/(2*A)) D > 0. 

pad ([ (C, N) | Poly ], ((C, N) | Polyl)) 

!, pad(Poly,Polyl). 
pad(Poly,((0,N)|Polyl)) 
pad(Poly,Polyl). 
pad((),()). 

linear(((Coeff,1)|Poly)). quadratic([(Coeff,2)| Poly)) . 

/* Program 22.Id Supporting code for Homogenization V 

/* offenders(Equation,Unknown,Offenders) 

Offenders is the set of offenders of the equation in the Unknown 

offenders(Equation,X,Offenders) :- 
parse(Equation,X,Offenders1\()), 
removeduplicates(Offendersl,Offenders). 

/* homogenize( 

V 


homogenize(Equation,X,Offenders,Equationl,XI) :- 
reduced_term(X,Offenders,Type,XI), 
rewrite(Offenders,Type,XI,Substitutions), 
substitute(Equation,Substitutions,Equationl). 

reduced_term(X,Offenders,Type,XI) :- 
classify(Offenders,X,Type), 
candidate(Type,Offenders,X,XI). 

/* Heuristics for exponential equations */ 

classify(Offenders,X,exponential) :- 

exponential__of fenders (Of fenders, X) . 

exponentialoffenders([A A B|Offs),X) 

freeof(X,A), subterm(X,B), exponential_offenders(Offs,X). 

exponential_of fenders((),X). 

candidate(exponential,Offenders,X,A A X) :- 

base(Offenders,A), polynoraial_exponents(Offenders,X). 

base([A A B|Offs),A) base(Offs,A). 

base((),A). 

polynomial_exponents([A A B|Offs],X) 

is_polynomial(B,X), polynomial_exponents(Offs,X). 

polynomial_exponents((),X). 

/* Parsing the equation and making substitutions */ 


V 
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/* parse(Expression,Term,Offenders) 

Expression is traversed to produce the set of Offenders in Term, 
that is the non-algebraic subterms of Expression containing Term */ 

parse(A+B,X,L1\L2) 

!, parse(A,X,L1\L3), parse(B,X,L3\L2). 
parse(A*B,X,L1\L2) 

!, parse(A,X,L1\L3), parse(B,X,L3\L2). 
parse(A-B,X,L1\L2) 

!, parse(A,X,L1\L3), parse(B,X,L3\L2). 
parse(A=B,X,L1\L2) 

!, parse(A,X,L1\L3), parse(B,X,L3\L2). 
parse(A A B, X, L) 

integer(B), !, parse(A,X,L). 

parse(A,X,L\L) 

freeof(X,A), !. 

parse(A,X,[A|L]\L) 
subterm(X,A), !. 

/* substitute (Equation, Substitutions, Equation!.) 

Equationl is the result of applying the list of 
Substitutions to Equation. 

*/ 

substitute(A+B,Subs,NewA+NewB) :- 

!, substitute(A,Subs,NewA), substitute(B,Subs,NewB). 
substitute(A*B,Subs,NewA*NewB) :- 

!, substitute(A,Subs,NewA), substitute(B,Subs,NewB). 
substitute(A-B,Subs,NewA-NewB) :- 

!, substitute^,Subs,NewA) , substitute(B,Subs,NewB) . 
substitute(A=B,Subs,NewA=NewB) :- 

1, substitute(A,Subs,NewA), substitute(B,Subs,NewB). 
substitute(A A B,Subs,NewA A B) 

integer(B), !, substitute(A,Subs,NewA). 

substitute(A,Subs,B) 

member(A=B,Subs), !. 

substitute(A,Subs,A). 

/* Finding homogenization rewrite rules */ 

rewrite((Off|Offs],Type,XI,(Off=Term|Rewrites)) :- 

homog_axiom(Type,Off,XI,Term), 
rewrite(Offs,Type,XI,Rewrites). 
rewrite([],Type,X,(]) . 


/* Homogenization axioms */ 

homog__axiom(exponential ,A A (N*X) , A A X, (A A X) ^N) . 
homogaxiom(exponential,A A (-X),A A X,1/(A A X)). 
homog_axiom(exponential,A A (X+B),A A X,A A B*A A X). 

/* Utilities */ 

subterm(Term,Term). 
subterm(Sub,Term) :- 

compound(Term), functor(Term,F,N), subterm(N,Sub,Term). 

subterm(N,Sub,Term) 

arg(N,Term,Arg), subterm(Sub,Arg). 
subterm(N,Sub,Term) 

N > 0, 

N1 is N - 1, 
subterm(Nl,Sub,Term). 

position(Term,Term,(]) 1. 

position(Sub,Term,Path) 

compound(Term), functor(Term,F,N), position(N,Sub,Term,Path), .. 

position(N,Sub,Term,[N|Path]) 

arg(N,Term,Arg), position(Sub,Arg,Path). 
position(N,Sub,Term,Path) 

N > 1, N1 is N-l, position (N1,Sub,Term,Path). 


free_of(Subterm,Term) :- 

occurrence(Subterm,Term,N), !, N=0. 

singleoccurrence(Subterm,Term) :- 

occurrence(Subterm,Term,N), !, N*l. 

occurrence(Term,Term,1) l. 

occurrence(Sub,Term,N) 

compound(Term), !, functor(Term,F,M), occurrence(M,Sub,Term,0,N). 

occurrence(Sub,Term,0). 


continued 
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occurrence(M, Sub,Term,N1 # N2) 

M > 0, !, arg(M,Term,Arg), occurrence(Sub,Arg,N), N3 is N+Nl, 
Ml is M-l, occurrence(Ml,Sub,Term,N3,N2). 
occurrence(0,Sub,Term,N,N). 

multiple([XI,X2|Xs]). 

removeduplicates((],(]). 
removeduplicates((X|Xs],[X|Ys]) 
remove_duplicates(Xs,Ys). 
remove_duplicates((X|Xs],Ys) 
member(X,Xs), 
remove_duplicates(Xs,Ys). 
compound(Term) functor(Term,F,N),N >0,!. 

% Program 22.2 /* Testing and data V 

test_press(X,Y) equation(X,E,U), solveequation(E,U,Y). 

equation(l,x A 2-3*x+2=0,x). 

equation(2,cos(x)*(l-2*sin(x))=0,x). 

equation(3,2 A (2*x) - 5*2 A (x+l) + 16 = 0,x). 
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ANSISYS.C accompanies, "A C Interface," by Don F. Ridgway, 
November, 1987, page 363. 


/★* ansisys.c 
* 

ft ANSISYS.C 

* (C) Copyright 1985 Don F. Ridgway 

* All rights reserved. 

* This program may be copied for 
ft personal, non-profit use only. 

* 

* This is an original and unique C programming 

★ language header/function file to #include with 

★ your C programs to give them "smart" cursor 

* control and eye-catching "turtlegraphics"- 

★ type screen and graphics display qualities. 

* 

ft Programmed by: 

ft Don F. Ridgway 

* Owner & Chief Programmer/Analyst 

* A-l IBM Programming & Training Service 

* CUSTOM BUSINESS PROGRAMS 

* 119 Plantation Ct., Suite D 

ft Temple Terrace, FL 33617-3731 

* Ph: (813) 985-3342 (10:00 am - 2:00 pm EST) 

* 

* Written, compiled & tested in Microsoft C, 

* ver. 2.03, and Lattice C, ver. 2.15, under 

ft PC-DOS 2.1 on a Compaq w/640Kb RAM & 8087, using 

* the TURBO Pascal 3.0 screen editor. (260+ lines.) 

* 

* NOTE: To utilize these macros you must have: (1) The 

* ANSI.SYS file that came with your PC-DOS or MS-DOS 2.xx 

ft operating system on your boot disk and, (2) you must boot 
ft up with a CONFIG.SYS file on that boot disk which 

* contains the statement: DEVICE = ANSI.SYS. This loads 

* the ANSI.SYS device driver into DOS at bootup time. The 

* operating system searches (for) CONFIG.SYS before it looks 
ft for an AUTOEXEC.BAT file. Please refer to your DOS 

* Reference Guide under "ANSI.SYS" and "COPY" for details. 

* 

ft (Simply, at A> prompt on a boot diskette, type: 

* COPY CON:CONFIG.SYS<cr> 

* DEVICE=ANSI.SYS<cr> 

ft <F6><cr> 

ft and then reboot and you're ready to go! Small bother 

ft for the brilliant performance gained in your C programs— 

ft just have these two files, ANSI.SYS and CONFIG.SYS, on 

* your boot disk whenever you boot up.) 

* 

ft (The diskette these programs are sent to you on is a 
ft PC-DOS 2.1 boot disk so you may boot up with it and run 

* ANSIDEMO.EXE. Note the ANSI.SYS and CONFIG.SYS files.) 

ft 

ft This custom C module/header file connects the C programming 
ft language to the MS-DOS/PC-DOS "ANSI.SYS" device driver 

* used to implement extended screen and keyboard functions. 

* Like any C program, each of the following macros can itself 

* become a building block for a still larger one. Note the 

* evolution of WINDOW(rowl,coll,row2,col2,fill,border) from 

* DRAW (rowl,coll,row2,col2,icon) and FILL(rowl,coll,row2,col2,fill). 

* 

ft Please refer to the MS-DOS/PC-DOS Reference Manual and the 

ft ANSI.SYS Device Driver commands for the "original" commands 

* and control sequences that are here made into C macros. 

* 

ft Refer to the IBM Technical Reference Manual or to the 
ft appendix of the BASIC Version 2 Reference for the ASCII 

ft Character Codes and the Extended Keyboard Function codes. 

* 

ft Run the ANSIDEMO.EXE for a superb demonstration of all these 
ft powerful macros and C programming tools in action. The 
ft actual source code is included in ANSIDEMO.C, an excellent 
* demonstration/introduction to the C programming language. 
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Simply #include "ansisys.c" this file in your programs 
to enable the following "smart” screen and cursor commands 
to really supercharge your C programs with professional 
features that are easier, safer and more portable than 
tacked-on assembly languge routines. 

Remember that C is "case sensitive" so be sure and 
reference the following macros with CAPITAL LETTERS. 


V 


* 

* 

**/ 

#define BEEP printf("\007") 

/* 800 Mz tone for 1/4 second — same as PRINT CHR$(7) 

Idefine CLEARSCREEN printf("\033[2J") 

#define CLS CLEARSCREEN 

/* clears the screen and positions cursor at top left corner */ 

/* "\033" is Octal for "Escape" or ASCII Decimal 27 (CHR$(27)) */ 

/* "Escape-[" is the lead-in for the ANSI.SYS code routines */ 

#define CURSPOS(x,y) printf("\033[%u?%uH",(x),(y)) 

Idefine XY(x,y) CURSPOS(x,y) 

/* positions cursor at x ■ row, y - column */ 
fldefine EOL printf("\033[K") 

/* erases to end of line, including cursor position */ 

/* NOTE: error in DOS documentation has *K* lower case */ 

#define XYEOL(x,y) printf("\033[%u;%uH\033(K",(x),(y)) 

/* positions cursor at x,y then erases to end of line */ 
fdefine XYWHERE printf("\033[6n");scanf("%*lc%2d%*lc%2d%*2c",&row,&col) 

/* requests cursor position, device driver answers row,col—declare int 


#define CURSUP(x) 
^define CURSDWN(x) 


/* cursor up or down x-many lines */ 


printf("\033[%uA",(x)) 
printf("\033[%uB",(x)) 


#define CURSFWD(y) 
#define CURSBCK(y) 


printf("\033[%uC",(y)) 
printf("\033[%uD",(y)) 


/* cursor forward (right) or backward (left) y-many spaces */ 


^define SAVCURS 
#define RECALLCURS 


/* 

/* 

/* 


printf("\033[s") 
printf("\033(u") 

/* cursor position is saved for later recall via RECALLCURS */ 

#define CPR(x,y,z) printf("\033[%u;%uH%c",(x),(y),(z)) 

idefine XYCHAR(x,y,z) CPR(x,y,z) 

/* position cursor at x,y and print char z (using ASCII code) */ 

#define XCTRPRINTF(x,str) printf("\033[%u?%uH%s",(x),((80-(strlen(str)-1))/2) , 

/* on row x, center (and printf) the string str (in double quotes) */ 
Udefine CURSPOSPRTF(x,y,str) printf("\033(%u;%uH%s",(x),(y),str) 

#define XYPRINTF(x,y,str) CURSPOSPRTF(x,y,str) 

/* at position x,y printf the string str (in double quotes) */ 
fldefine XKREAD(x) x=0;x=bdos(1);if (bdos(ll)) x=bdos(8)+128 

/* extended code keyboard read, reads function keys, arrow keys, etc. */ 
^define XKREADE(x) x=0?x=bdos(l);if (bdos(ll)) x=bdos(1)+128 

/* same as XKREAD(), except this one echoes the input on the screen */ 
#define CHKBRK if (key==196) break 

/* if F10 key was pressed, break out of loop */ 

#define SETSCREEN(a) printf("\033(*%uh",a) 

set screen graphics mode */ 

0=40x25 monochrome,1=40x25 color,2=80x25 mono,3=80x25 color, 

4=320x200 color,5=320x200 mono,6=640x200 mono,7=enable word-wrap. 

Udefine RESETSCREEN(a) printf("\033(=%ul",a) 

/* reset screen graphics mode */ 

/* the attributes are same as SETSCREEN(a) except 7=disables word-wrap 
#define SETDISPLAY(a,b,c) printf("\033[%u;%u;%um",a,b,c) 

/* set screen display attributes and colors = (a,b,c) any order: 

/* 0 = default, 1 = high intensity, 4 = underline, 

/* 5=blinking,7=inverse,8-invisible (black-on-black),30=foreground black, 

/* 31=fore red,32=fore green,33=fore yellow,34=fore blue,35=fore magenta, 

/★ 36=fore cyan,37=fore white,40=background black,41=back red,42=back green,*/ 

/* 43=back yellow,44=back blue,45=back magenta,46=back cyan,47=back white. */ 
#define HLON SETDISPLAY(0,0,1) 

/* set high light (high intensity) on */ 

#define BLON SETDISPLAY(0,0,5) 

/* set blinking on */ 

#define HLOFF SETDISPLAY(0,0,0) 

#define BLOFF HLOFF 

/* set high intensity, blink (and all other display attributes) to off * 
^define PROMPT(x,y,cc) SETDISPLAY(0,0,7);printf("\033[%u;%uH",(x) , (y) 

cc=getchar();SETDISPLAY(0,0,0) 

/* at position x,y read inverse prompt for input cc */ 
fldefine XKPROMPT(x,y,z) HLON?XY((x),(y))?printf(" \b");XKREAD(z);HLO 

/* at position x,y read highlighted prompt for input z */ 

#define WINDOW(a,b,c,d,e,f) DRAW(a,b,c,d,f)?FILL(a+l,b+2,c-l,d-2,e) 

/* a rectangle determined by upper left-hand corner coordinates, */ 

/* rowl » a, coll = b, and lower right-hand corner coordinates, */ 

/* row2 = c, col2 = d, is filled with extended graphics character */ 

/* ASCII decimal code e, and the border is ASCII decimal code f */ 
^define WIND0W2(a,b,c,d,e,f) DRAW(a,b,c,d,f)?DRAW(a+l,b+l,c-l,d-l,255) ?\ 

FILL(a+l,b+2,c-1,d-2,e) 


V 

V 


V 

V 

V 

V 

V 
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/* same as WINDOW(a,b,c,d,e,f) except use this one to overwrite other */ 
/* drawings because this one fills empty spaces with blanks */ 


/* 

/** 

/* 

/* 

/* 

/* 

/* 

/* 

/* 

/* 

/* 

/* 

/* 

/* 

/* 


DRAW(rowl,coll,row2,col2,icon) 

can be rectangle, vertical line, horizontal line or point! 

rowl,coll=Upper Left-hand corner of border 
row2,col2=Lower Right-hand corner 

icon=ASCII Decimal number of Character want border made of 

(Note: Error-trapping is up to you in calling program, 

e.g., (0<=row<=*24 ], (0<=col<=80), graphics mode, 

etc.) 

Dbl Lines=205;Sngl Line= 196 ;Dark=176;Medium=177;Light=178 
White=219;Blank=255;Sunshine=15;Music notes=14 ; Asterisks=»42 


/* Happy Face= 1,2; Hearts-3 ? Diamonds=4 ; Clubs=5 ?Spades=*6; Beeps-7 

/*- 

/**/ 


V 

V 

V 

V 

V 

V 

V 

V 

V 

V 

V 

V 

V 

V 

V 

V 

V 


DRAW(rowl,col1,row2,col2,icon) 
int rowl,coll,row2,col2,icon; 

int hlen,vlen,r,c,hzl,vtl,ulc,llc,urc,lrc; 


hlen=col2-coll? 

vlen=row2-rowl; ... . . . , 

if (hlen<0 || vlen<0) BEEP; /* audibly alert possible input error */ 

if (hlen<=0 && vlen<=0) /* then it's a point or a corner */ 

CPR(rowl,col1,icon)? 
return(0)? 

> 

if (vlen<=0) /* then it's a horizontal line */ 

( 

CURSPOS(rowl,coll); 
for (c^O;c<»hlen;c++) 
printf("%c M ,icon); 
return(0)? 

) 


switch (icon) 

/* for Single line border */ 

hzl-196;vtl-179;ulc-218;llc-192;urc»191?lrc*217; 
break; 

/* for Double line border */ 

hzl=205;vtl»186;ulc=201;llc=200;urc=187;lrc«188; 
break; 

/* for Double top, single side */ 
hzl®205 ;vtl**179 ;ulc-213 ; 11c®212 ;urc=184 ;lrc«190; 
break; 

hzl»vtl«ulc*llc=urc«lrc»icon; /* for same char all around */ 


/* it's a vertical line -- use vtl from above */ 

CURSP0S(rowl,coll); 
for (r*rowl;r<=row2;r+t) 

CPR(r,coll,vtl)? 
return(0); 

) 

CURSPOS(rowl,coll); 
for (c®l;c<=hlen;c++) 
printf( M %c”,hzl)? 

CPR(rowl,col2,urc)? 
for (r»rowl+l;r<row2;r++) 

CPR (r,col2,vtl)? 

CPR(row2,col2,lrc); 

CURSPOS(row2,col2-l); 
for (c-l;c<*hlen;c++) 
printf(”%c\b\b",hzl); 

CPR(row2,coll,11c)? 
for (r«row2-l?r>rowl;r—) 

CPR(r,coll,vtl); 


/* if it’s fallen through this far it's a rectangle 

/* print horizintal icon top row, left to right */ 

/* print upper right-hand corner */ 

/* print vertical right-hand column, top to bottom 

/* print lower right-hand corner */ 

/* print horizontal bottom row, right to left */ 

/* one forward, two back (NOTE: this is slow) */ 

/* print lower left-hand corner */ 

/* print vertical left-hand column, bottom to top * 


case 196: 
case 218: 


case 201: 
case 205: 

case 213: 

default: 

) 

if (hlen< ss 0) 


continued 
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CPR(rowl,coll,ulc)? /* print upper left-hand corner to complete object 

return(0); 

} /* end DRAW() function */ 


/*-*/ 

/** FILL(rowl,coll,row2,col2,icon) */ 

/* V 

/* can be "window/ 1 vertical line, horizontal line or point! */ 

/* V 
/* rowl,coll=Upper Left-hand corner of area-to-be-filled */ 
/* row2,col2=Lower Right-hand corner */ 
/* icon=ASCII Decimal number of Character want area filled with */ 

/* V 
/* (Note: Error-trapping is up to you in calling program, */ 
/* e.g., [0<=row<=24), [0<-col<=80], graphics mode, */ 
/* etc. */ 

/* V 
/* Dbl Lines=205;Sngl Line=196;Dark=176;Medium=177?Light«178 */ 
/* White=219;Blank=255;Sunshine=15;Music notes=14;Asterisks=42 */ 
/* Happy Face-1,2;Hearts=3?Diamonds=4;Clubs=5;Spades=6?Beeps=7 */ 


FXLL(rowl,coll,row2,col2,icon) 
int rowl,coll,row2,col2,icon? 

{ 

int hlen,vlen,r,c; 

hlen=col2-coll? 
vlen=row2-rowl? 

if (hlen<0 || vlen<0) BEEP; /* audibly alert possible input error */ 

for (r=rowl?r<=row2?r++) 

{ 

CURSPOS(r,col1)? 

( 

for (c=0;c<=hlen;c++) 
printf("%c",icon) ; 

) 

) 

return(0)? 

) /* end FILL() function */ 


ANSIDEMO.C accompanies, ”A C Interface,” by Don F. Ridgway, 
November, 1987, page 363. 


/** 

★ 

* 

* 

* 

* 

* 

★ 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

★ 

* 

* 

* 

* 

* 

* 

* 

* 

* 


ANSIDEMO.C 
ANSIDEMO.C 

(C) Copyright 1985 Don F. Ridgway 
All Rights Reserved. 

This program may be copied for 
personal, non-profit use only. 

Don F. Ridgway 

Owner & Chief Programmer/Analyst 

A-l IBM Programming & Training Service 

Custom Business Programs 

119 Plantation Court, Suite D 

Temple Terrace, FL 33617-3731 

Ph: (813) 985-3342 (10:00am - 2:00pm EST) 

Written, compiled and tested in Microsoft C, 
ver. 2.03, and Lattice C, ver. 2.15, under 
PC-DOS 2.1 on a Compaq w/640Kb RAM & 8087 
using the PC-DOS 3.0 LINK and the TURBO 
Pascal 3.0 screen editor. 

(470 lines of code.) 

This program demonstrates the features and 
capabilities of my C programming language 
header/module file named "ANSISYS.c”, which 
activates and implements the MS/PC-DOS 
"ANSI.SYS” device driver for extended screen 
and keyboard functions and control sequences. 
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* NOTICE: To run this program you MUST have booted 

* up with the DOS "ANSI.SYS" file on your boot disk 

* with a "CONFIG.SYS" file containing the statement 

* "device = ansi.sys" on your boot disk. (Other- 

* wise you’ll get meaningless numbers and symbols 

* across your screen. If so, hit F10 or 'O' to exit 

* then boot up properly. See the introduction to 

* ANSISYS.C for instructions on how to make the 

* CONFIG.SYS file.) 

* 

* The "ANSISYS.c" file is to be #included in 

* your C programs to give them "smart" cursor 

* control and eye-catching "turtlegraphics"-type 

* screen/graphics display capability. 


**/ 

ifinclude <stdio.h> 

^include "ansisys.c" 

main() 

( 

int dd,keyl; 

while (keyl 196 && keyl l® 48) 

( 

if (dd=»=0) 

mainmenu(); 

XKPROMPT(20,29,key1)? 
dd=0 ; 

switch(keyl) 

( 

case 187: 
case 49: 

shoscreen(); 
break; 

case 188: 
case 50: 

shodisplay()? 
break; 

case 189: 
case 51: 

xkeyboard(); 
break; 

case 190: 
case 52: 

cursarrow(); 
break; 

case 191: 
case 53: 

showdraw(); 
break; 

case 192: 
case 54: 

showfill(); 
break; 

case 193: 
case 55: 

showindow(); 
break; 

case 196: 
r case 48: 

break; 

default: 

dd=l; 
break; 

) 

) 

XYPRINTF(23,1,"Goom\nbye!")? 

BEEP; 

exit(0); 

) 


/* this is the file to finclude in all 
/* your C programs from now on to enable 
/* all of the following fabulous screen, 
/* cursor and keyboard features 

/* while keyl not equal to F10 or '0* */ 
/* show main menu V 


/* FI key — Set Screen & Graphics */ 
/* *1* key — just in case some jelly */ 
/* spilled on the Function keys */ 


/* F2 key — Set Display & Color */ 
/* '2' key */ 


/* F3 key — Extended Keyboard demo */ 
/* *3' key V 


/* F4 key — Arrow Keys demo */ 
/* '4' key */ 


/* F5 key — DRAW function demo */ 
/* '5' key V 


/* F6 key — FILL function demo */ 
/* '6* key */ 


/* F7 key — WINDOW function demo */ 
/* '7* key */ 


/* F10 key — to exit program */ 
/* 'O' key */ 


/* any other key loops back around */ 

/* end switch */ 

/* end while */ 


/* end main ANSIDEMO.c */ 


/* 

* 

V 


mainmenu() 

( 

CLS; 


/* 


/* 

DRAW(3,19,23, 

,61,213 )t 

/* 

HLON; 


/* 

DRAW(4,21,22, 

,59,178); 

/♦ 


draw Main Menu +/ 
clear screen */ 

draw distinctive one/two line border * 
turn high-intensity display on */ 
draw artistic inside border to offset 


continued 
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XYPRINTF(2,31,"A N S I D E M O . c")? 

XYPRINTF(24,29,"(c) 1985 Don F. Ridgway") ; 

HLOFF? /* turn high-intensity off */ 

XYPRINTF(6,28, *'F1) Set Screen/Graphics")? 

XYPRINTF(8,28,"F2) Set Display/Color")? 

XYPRINTF(10,28,"F3) Extended Keyboard Keys")? 

XYPRINTF(12,28,"F4) Cursor Arrow Keys")? 

XYPRINTF(14,28,"F5) DRAW Border,Line,Point")? 

XYPRINTF(16,28,"F6) FILL macro/function")? 

XYPRINTF(18,28,"F7) WINDOW macro/function”); 

XYPRINTF(20,28,” <- (F10 to Exit)")? 

return(0)? 

) /* return to main program */ 


/* 

* 

V 


shoscreen() 

{ 

int c? 

/* 

Set Screen Graphics demo */ 

CLS? 

/* 

clear screen */ 

while (c!=9) 

/* 

while not number 9 */ 


{ 

DRAW(1,1,1,80,178) ? 

XCTRPRINTF(5,"This is Set Screen - Set Graphics Demo")? 

XCTRPRINTF(7,"0=40x25 monochrome,1=40x25 color, 2=80x25 mono, 3=80x25 col 
XCTRPRINTF(9,"4=320x200 color, 5=320x200 mono,6=640x200 mono,7=enable wo 
c= • 

XYPRINTF(12,5,"Enter # of Graphics Mode desired ( 9 => Exit) : ")? 
scanf("%d",&c)? 

if (c==9) break? /* if 9 break out of loop */ 

SETSCREEN(c)? 

XYPRINTF(15,1,"ABCDEFGHIJKLabcdefghij kl")? 

XCTRPRINTF(18,"1234567890")? 

) 

return(0)? 

) /* return to main menu */ 


/* 

* 

V 


shodisplay() 

{ 

int c,d,e? 


/* Set Display/Color attributes demo */ 


/* while not number 9 */ 


CLS ? 

while (c!=9) 

( 

DRAW(1,1,1,80,178)? 

XCTRPRINTF(3,"This is Set Display/Color Attributes Demo")? 
XCTRPRINTF(5,"Set screen display attributes and colors:")! 


XYPRINTF(7,1," 0 = default, 

XYPRINTF(8,1," 5 = blink, 

XYPRINTF(10,1,"30 = FOREGROUND black, 
XYPRINTF(11,1,"34 = fore blue, 
XYPRINTF(13,1,"40 = BACKGROUND black, 
XYPRINTF(14,1,"44 - back blue, 
c=d=e= 1 •? 


1 = high-intensity, 4 » underline,"); 


7 = inverse, 

31 - fore red, 

35 - fore magenta, 
41 « back red, 

45 = back magenta, 


8 = invisible (black-o 
32 = fore green, 33 = 

36 = fore cyan, 37 = 

42 = back green, 43 = 

46 = back white.")? 


XYPRINTF(16,1,"Enter three numbers, seperated by SPACES of Display/Color d 
XYPRINTF(17,1,"putting numbers in right-hand columns first, e.g., 0 0 5 is 
XYPRINTF(18,1,"(A *9'in any column will Exit) '0 0 O' resets to normal " 
XY(18,58)? 

scanf("%d %d %d",&c,&d,&e)? /* careful! no error-trapping h 

if ( C ««9||d««9||e==9) break? /* if any number 9, break out * 

SETDISPLAY(c,d,e)? 

DRAW(18,58,18,80,255)? 

XCTRPRINTF(20,"Is this what you wanted?")? 

) 


return(0)? 

) /* return to main menu */ 


xkeyboard() /* Extended Keyboard demo */ 

( 

int c? 
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CLS; 

HLON? 

DRAW(1,1,1,80,178); 

HLOFF* 

printf("\nHello there. This is Extended Keyboard Demo ('*' = Exit )\n\n\n"); 

while (c!* 3 ** 1 ) /* while not •*• */ 

{ 

printf("\n -> Press ANY key on the keyboard: ")? 

XKREAD(c)? /* no-echo read ♦/ 

printf(" The extended-keyboard-read code = %d",c) ? 

> 


return(0)? 

) 


/* return to main menu */ 


V 


cursarrow() 

( 

int key? 

/ 

CLS? 

HLON; 

/ 

DRAW(1,1,1,80,178)? 

HLOFF? 


XCTRPRINTF( 3 ,"Move cursor 
XY(12,40)? 

with ARROW ] 

SAVCURS? 

/ 

while (key !- '*') 

{ 

XKREAD(key)? 

/ 

/* 

switch(key) 

{ 

case 199: 

/* 

XY(1/1)? 
break? 


case 200: 

/* 


/* Display use of cursor arrow keys */ 


/♦ clear screen */ 


/* HOME key */ 


/♦UP arrow key */ 

printf("\033[lA\b"); /* —> NOTE: When utilizing these macros 
/♦ CURSUP(l); ♦/ /* from the actual keyboard, as we are do 

/♦ in this demo, they need a '\b' backspa 
break; /* because hitting the key moves it forwa 

/* LEFT arrow key ♦/ 

/♦ NOTE the (2) per above reason (need tw 
/* spaces back to overcome the one forwar 
/* RIGHT arrow ♦/ 

/♦ NOTE letting it move forward by itself 
/♦ because of the physical keystroke 
/* END (of screen) key ♦/ 


case 203: 

CURSBCK(2)? 
break ? 

case 205: 

/* CURSFWD(l);*/ 
break? 

case 207: 

XY(24,79)7 
break; 

case 208: 

printf("\033[lB\b"); /* DOWN key ♦/ 
/* CURSDWN(1)? */ 
break; 

case 42: 

break? 

default: 

CURSBCK(l) ? 
break? 

) 


/* see NOTE on UP arrow key */ 
/* hit '*• to quit program */ 


/♦ Any other key, while not doing any- */ 
/* thing, nevertheless needs to be moved 
/* back where it was. See NOTE UP arrow 
/* end switch */ 

) /* end while ♦/ 

RECALLCURS? /* recall cursor (to 12,40) */ 

puts( M Press any key to return to Main Menu 11 ) ? /* then print message */ 

XKREAD(key)? 

CLS? 

return(0)? 

/* end cursarrow demo */ 


/* 

* - 

V 


*jhowdraw() 

( 

int a,b,c,d,e,key? 
char ♦greet; 

greet«"Hi there — I'm Fast-draw Demo!"; 


/♦ DRAW(rowl,coll,row2,col2,icon) demo ♦/ 


continued 
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CLS; 


XCTRPRINTF(2, ”Demo of DRAW(rowl,coll,row2,col2,icon )")7 


DRAW(5,9,20,71,205) 

DRAW(6,11,19,69,176)? 

DRAW(7,12,18,68,177)? 

DRAW(8,13,17,67,178)? 

DRAW(9,14,16,66,219)? 

DRAW(11,20,14,60,196)? 

HLON; 

XCTRPRINTF(12,greet); 

DRAW(21,3,21,77,207)? 

DRAW(22,3,22,77,178)? 

DRAW(8,4,8,4,14)? 

DRAW(16,4,16,4,2)? 

DRAW(8,76,16,76,219); 

DRAW(8,75,16,75,182)? 

HLOFF ? 

CURSPOSPRTF(24,46,"Press any key to continue ”) 
XKREAD(key)? 
key=99 ; 

CLS; 

while (key!=81&&key1=113) 


/* little demo display */ 


{ 

if 


(key= 

( 


=99||key==67) 


/* while not Capital Q or lower case q q)uit */ 
/* NOTE: The possibility of upper or lower case 
/* entry is handled throughout in this fashion 
/* this program could more "stand on its own” a 
/* not require the islower() or toupperQ funct 
/* to be #included from ctype.h header file 

/* if C)learscreen */ 


XCTRPRINTF(1,"Demonstration of DRAW(rowl,col1,row2,col2,icon)”) ? 
SETDISPLAY(0,0,1)? /* high intensity */ 

DRAW(3,1,3,80,196); /* border line */ 

SETDISPLAY(0,0,0); 

CURSPOSPRTF(2,3,”-> Enter rowl,coll,row2,col2,icon, SPACES delimiting: ")? 
XCTRPRINTF(4,"Try: 10 25 15 55 205, 5 9 20 71 178, 13 1 13 80 219, 9 24 16 56 2 
)? 

key=a=b=c=d=e=0 ? 

CURSPOSPRTF(2,59,”.”) ; 

CURSPOS(2,59)? 

scanf(”%d %d %d %d %d",&a,&b,&c,&d,&e)? 


/* blink the 
/* A,E,C and Q 


DRAW(a,b,c,d,e); 

CURSPOSPRTF(24,46,"A)nother E)raselast C)LS Q)uit?”); 
SETDISPLAY(0,0,5) ; 

CPR(24,46,65) ? 

CPR(24,55,69)? 

CPR(24,66,67) ; 

CPR(24,71,81)? 

CURSPOS(24,79); 

SETDISPLAY(0,0,0); 

XKREADE(key)? 
if (key==97||key==65) 

DRAW(24,46,24,80,255); 
else if (key==99||key==67) 

CLS; 

else if (key==101||key==69) 

{ 

DRAW(a,b,c,d,255); 

DRAW(24,46,24,80,255); 

) 


/* initialize */ 

/* little input guide — don't 
/* to follow exactly but just s 
/* between entries and hit carr 
/* return at end. If goof, do 
/* to start all over again, (so 
/* Careful! No input error-chec 


V 

V 


/* 

/* 

/* 

/* 

/* 


extended keyboard read */ 
do A)nother */ 

C)learScreen,restart */ 

E)rase last figure */ 

redraw with blanks */ 


) 

CLS; 

return(0); 

) 


/* 

/* 


Q)uit falls through */ 
end while */ 


/* end of Showdraw Demo */ 


/* 

+ 

V 


showfill() /* Demo of FILL(rowl,coll,row2,col2, fill) 

( 

int a,b,c,d,e,key; 

CLS; 

XCTRPRINTF(2,"Demo of FILL(rowl,coll,row2,col2,fill)"); 

FILL(10,25,15,55,219); /* little razzledazzle */ 

FILL(5,9,20,71,197); 

FILL(4,40,24,40,221); 

FILL(5,41,20,71,255); 

FILL(10,45,15,75,219); 

CURSPOSPRTF(24,46,"Press any key to continue ”); 

XKREAD(key); 
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/* while not Q)uit */ 
/* if C)learscreen */ 


key=99? 

CLS * 

while (key!=81&&key!=113) 

{ 

if (key==99||key==67) 

XCTRPRINTF(1,"Demonstration of FILL(rowl,coll,row2,col2, fill)"); 
SETDISPLAY(0,0,1)? /* high intensity */ 

DRAW(3,1,3,80,196); /* border line */ 

SETDISPLAY(0,0,0)? 

CURSPOSPRTF(2,3,"-> Enter rowl,coll,row2,col2,fill, SPACES delimiting: ") ? 
XCTRPRINTF( 4,"Try: 10 25 15 55 219, 5 9 20 71 197, 4 40 24 40 221, 9 24 16 56 17 
); 

key=a=b=c=d=e=0; /* initialize */ 

CURSPOSPRTF(2,59, M .") ? /* little input guide */ 

CURSPOS(2,59)? 

scanf( M %d %d %d %d %d",&a,&b,&c,&d,&e)? 

FILL(a,b,c,d,e)? /* careful! — no input */ 

/* error-checking here! */ 

CURSPOSPRTF(24,46,"A)nother E)raselast C)LS Q)uit?"); 

SETDISPLAY(0,0,5) ? 


CPR(24,46,65) ; 

CPR(24,55,69)? 

CPR(24,66,67)? 

CPR(24,71,81)? 

CURSPOS(24,79)? 

SETDISPLAY(0,0,0); 

XKREADE(key)? 
if (key==97||key==65) 

XYEOL(24,46)? 

else if (key==99||key==67) 
CLS; 

else if (key==101||key==69) 
( 

FILL(a,b,c,d,255)? 

XYEOL(24,46)? 

) 

) 

CLS? 

return(0)? 

) 


/* blink the */ 
/* A,E,C and Q */ 


/* extended keyboard read V 
/* do A)nother V 

/* C)learscreen,restart */ 

/+ E)rase last figure */ 

/* refill with blanks V 

/* Q)uit falls through */ 

/* end while */ 

/* end of Showfill Demo */ 


/* 

it 

V 


showindow() 

( 


/* WINDOW(rowl,coll,row2,col2,fill,bord) 


int a,b,c,d,e,f,key; 

CLS; /* clearscreen V 

XCTRPRINTF (2, •'Demo of WINDOW(rowl, coll, row2, col2, fill, bord) ") ? 

WINDOW(10,25,15,55,219,205); /* - V 

WINDOW(8,23,19,59,178,213)? /* if you got it */ 

WINDOW(5,65,10,75,219,196)? /* - */ 

WINDOW(15,5,20,15,254,205)? /* flaunt it! */ 

WINDOW(5,1,7,63,14,219)? /* - V 

WINDOW(15,70,15,70,7,2)? 

CURSPOSPRTF(24,46, M Press any key to continue M )? 

XKREAD(key)? 
key«99? 


CLS? 

while (key!«81&&key!“113) /* while not Q)uit do */ 

( /* note upper/lowercase */ 

if (key==99||key««67) /* if screen's cleared */ 

{ /* redraw header-menu V 

XCTRPRINTF(1,"Demonstration of WINDOW(rowl,coll,row2,col2,fill,bord)")? 
SETDISPLAY(0,0,1)? /* set high intensity V 

DRAW(3,1,3,80,196)? /* border line V 

SETDISPLAY(0,0,0)? /* set display normal V 

CURSPOSPRTF(2,1,"-> Enter coordinates & fill & border with SPACE delimit: 

XCTRPRINTF(4,"Try: 10 25 15 55 219 205, 5 65 10 75 219 196, 9 24 16 56 219 213") 

); 

key=a=b=c=d=e=f=0 ? 

CURSPOSPRTF (2,59,".") ? 

CURSPOS(2,59)? 

scanf("%d %d %d %d %d %d",&a,&b,&c,&d,&e,&f); 

WINDOW(a,b,c,d,e,f)? 


/* 

/* 

/* 


initialize 
little input guide 
position cursor 
/♦BE CAREFUL!!! — 


V 

V 

V 

no 


CURSPOSPRTF(24,46,"A)nother E)raselast C)LS Q)uit?")? 


/* error-checking here! 


V 

V 


SETDISPLAY(0,0,5)? 
CPR(24,46,65)? 
CPR(24,55,69)? 
CPR(24,66,67)? 

CPR(24,71,81)? 
CURSPOS(24,79)? 


/* set display to blink */ 
/* print/blink the 'A' */ 
/* blink 'E' 

/* blink 'C' 

/* blink 'Q' 

/* position cursor 


V 

V 

V 

V 
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SETDISPLAY(0,0,0) ? 

/* 

set display normal 

V 

XKREADE(key); 

/* 

extended keyboard read */ 

if (key==97||key==65) 

/* 

do A)nother 

V 

XYEOL(24,46)? 

/* 

erase line 24 menu 

V 

else if (key==101||key==69) 

( 

FILL(a,b,c,d,255)? 

/* 

E)rase last figure 

V 

/* 

refill with blanks 

V 

DRAW(24,46,24,80,255)? 

) 

else if (key==99|lkey==67) 

/* 

erase line 24 menu 

V 

/* 

C)learscreen,restart */ 

CLS; 

/* 

Q)uit falls through 

V 

) 

/* 

end while 

V 

CLS? 

/* 

clear screen so image */ 

return(0)? 

/* 

ends with program 

V 

) 

/* 

end of WINDOW Demo 

V 


/* 

*** the end of ANSIDEMO.c — hope you liked it! — C you again sometime? ** 

V 


ARS.C accompanies, "Recursion + Data Structures = Anagrams," by 
Mike Morton, November, 1987, page 325. 


/* ARS.C— 

A dictionary-driven program which finds all possible anagrams using a 
recursive search. Words and phrases are represented by compact "bit 
signatures", which can be easily subtracted with underflow detection. 


Written by Mike Morton in LightspeedC, October 1986. 

Demo version for publication (c) 1986 by Michael S. Morton. 
Portions of the executable version (c) 1986 by Think Technologies, 
Inc. 


Functions included: 


V 


STARTUP: 

choosefields — decide where fields go in a signature 
makeonesig — make the bit signature for a word 
makeuf — compute the "underflow" signature 
getwords — read the dictionary and store all usable 
words 

storeword — store a usable word 
makeallsigs — make bit signatures for all usable words 
SEARCH ROUTINES: 

findanagrams — recursively search from a given node in the 
tree 

printanagrams — print an anagram from the recursion stack 
UTILITY ROUTINES: 

clean — remove non-alphabetics and map to lowercase 
usable — see if a word is usable in anagrams for a 
phrase 

makefreqs — find frequency distribution for a string 
fieldwidth — compute minimum field width for a frequency 
count 

die — print dying words and cash in the chips 


^include "stdio.h" 

#include "storage.h" 
#include "ctype.h" 


/* for terminal and file I/O */ 

/* for doing mallocs, reallocs */ 

/* for isalpha(), isupper(), etc. */ 


/**** Easily changeable constants: 
^define STRMAX 100 
^define STACKMAX 20 

^define SCRLEN 22 


+ * + */ 

/* size of character strings */ 

/* recursion max (max words/anagram) 

V 

/* count of output lines between 
pauses */ 


/** The anagram-equivalent of a word is stored in a "bit signature"**/ 


/* NOTE: the "switch" in findanagrams() depends on MAXMASKS */ 

Udefine bitmask long /* a "bitsig" is made of 

"bitmasks" */ 

^define MAXMASKS 3 /* at most this many masks per 

signature */ 

typedef bitmask bitsig(MAXMASKS]; /* so, a bit signature looks like 

this */ 

^define maskwidth (8*sizeof(bitmask)) /* number of bits per bitmask */ 
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/**** Global information 
char phrase [STRMAX]; 
int freqs [26]; 
bitsig phrasesig? 
bitsig uflosig? 


about the phrase being anagrammed: ****/ 

/* the phrase */ 

/* frequency distribution of phrase */ 
/* bit signature for the phrase */ 

/* bit signature to detect underflow */ 


/*♦** Each letter in the 
int letmask [26]? 
int letbit [26]? 
int letwidth[26]? 
int lastmask; 


phrase has a field in the bit signature: ***♦/ 
/* which mask is each letter's field in? */ 
/* what bit # does each field start at? */ 
/* how wide is field for each letter? */ 

/* highest mask # used (0..MAXMASKS-1) */ 


/**** Dictionary information: 
char **wordlist = NULL; /* 

int maxwords *0; /* 

int numwords? /* 


char *textnext 
int textleft = 


NULL; 


0 ? 


****/ 

dynamic array of pointers to words */ 
wordlist has bounds [0..maxwords-1] */ 
usable words are in [0..numwords-1] */ 
/* next character to store a word at */ 

/* characters left in current text chunk */ 


/* Since we don't always use all bitmasks in a signature, when we 
allocate bit signatures for the usable words, we may use smaller 
signatures (with as few as 1 bitmask). Hence this array is really 
a list of shrunken bitsigs, but is ACCESSED as bitmasks. */ 

bitmask *wordsigs? /* bitsigs for usables; [0..numwords-1] */ 


/***♦ For printing anagrams: ♦ ***/ 

char *anawords [STACKMAX]? /* recursion stack to remember words */ 

char **anaptr? /* stack ptr (points to 1st unused slot) */ 

long anacount =0? /* total number of anagrams found */ 


/***★ Main program: *♦**/ 

/* Get the phrase, neaten it, find the letter frequency distribution. 

Use the distribution to decide where fields go in the bit signature. 
Calculate the signature for the phrase and the "underflow" signature. 
Search the dictionary for all usable words and make their signatures. 
Set up the recursion stack and start the search. */ 

main() /* anagram generator */ 

printf ("What's the phrase you'd like to anagram? ")? /* prompt 'em */ 
gets (phrase)? /* get the phrase */ 

clean (phrase); /* remove junk chars? make it lower case */ 

makefreqs (phrase, freqs)?/* find the frequency distribution */ 
choosefields (freqs); /* assign fields for letters; check size */ 
makeuf (freqs, letmask, letbit, letwidth)? /* compute underflow bit 

sig */ 

makeonesig (phrase, phrasesig); /* make bit signature for phrase */ 


getwords(); /* get all words usable for this phrase */ 

makeallsigs(); /* make signatures for them all */ 


anaptr ■ anawords; /* initialize the stack pointer */ 

findanagrams (0, phrasesig); /* find & print all anagrams for 

phrase */ 

printf ("\n %ld anagrams found.\n", anacount); /* be informative */ 
) /* end of main program */ 


/**** clean — Map alphabetics 


else. *♦**/ 

clean (s) 


char 

*s? 

/* 

char 

♦out ■ s; 

/* 

char 

c; 

/* 


to lowercase and discard everything 

UPDATE: string to clean in place */ 

output pointer */ 

working copy of character */ 


while (c - *s++) /* loop through whole input string */ 

( 

if (isupper (c)) c — ('A' - 'a')? 

/* if uppercase, map to lowercase */ 
if (isalpha (c)) *out++ =» c? /* and keep only alphabetics */ 
) /* end of loop mapping & discarding */ 

*out++ - c; /* store the final null */ 

) /* end of clean() */ 


/**** makefreqs — Take a phrase and produce its frequency table. ****/ 
makefreqs (s, ftable) 

char *s? /* INPUT: string to analyze */ 

int ftablef]; /* OUTPUT: frequency distribution V 


int i; 


/* loop index */ 


continued 
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for (i =* 0? i<26; i++) /* 

ftable [i] = 0; /* 

while (*s) /* 

ftable [*s++ - 'a'] ++? /* 

) /* 


loop through and initialize... */ 
...the frequency array */ 
while there*s more to the 
string... */ 

...bump frequency slot; advance 
s */ 

end of makefreqs() */ 


/**** choosefields — assign bit positions for each letter in the 
phrase. ****/ 

/* For each letter, assign it a field in the bit signature. To do this, 
find how wide the field is with fieldwidth(), then decide whether 
there's enough room for it in the current mask (kick to the next mask 
if necessary) and allocate room for it. Then remember all information for 
the letter. */ 


choosefields (freqs) 

int freqs (]? /* INPUT: phrase's frequency table */ 

/* GLOBAL OUTPUT: letmask[], letbitf), letwidthf), lastmask */ 

{ 

int letter? /* letter value (0..25) */ 

int curmask = 0, curbit =0; /* initial mask and bit numbers */ 

int width? /* fieldwidth of letter's field */ 


for (letter » 0? letter <26? letter++) /* loop through all letters */ 
if (freqs(letter] !* 0) /* any occurrences of this letter? */ 

{ /* yes: find where it'll go */ 

width » fieldwidth (freqs [letter])? /* how much room does it 

need? */ 


if (curbit+width > 

{ 

if (++curmask >= 
die ("Sorry — 

curbit = 0? 

) 


maskwidth) /* too wide to fit in rest of this 
mask? */ 

/* yes: have to kick into next mask */ 
MAXMASKS)/* next mask number? is there room? */ 
that phrase is too long to handle.\n") 

/* nope */ 

/* start at 1st bit of next mask */ 

/* end of kicking into next mask */ 


letmask [letter] = curmask? 

letbit [letter] - curbit? 
letwidth [letter] = width? 
curbit += width? 


/* note which mask this letter goes 
in */ 

/* ..and bit position in the mask */ 
/* ..and the width */ 

/* advance past this bit field */ 


> 


/* end of handling char found in phrase */ 


lastmask » curmask; 

) 


/* remember highest used mask number */ 
/* end of choosefields() */ 


/*★** fieldwidth — Find the width of field needed to store a 
count. ****/ 

/* Find how wide a bit field we need to store a small integer. We're 
passed the maximum count we'll ever see for that letter, and find the 
smallest field which can hold that count. Then we add in 1 more bit 
for the "underflow" bit. Our output looks like: 

Freq Width (+ 1 underflow bit) 

1 1 (+ 1 ) 

2.. 3 2 (+ 1) 

4.. 7 3 (+ 1) ...etc. */ 


int fieldwidth (count) 

/* 

int count? 

( 

int width = 1? 

/* 

/* 

while (count !- 0) 

{ 

width++ ? 

/* 

/* 

count »« 1? 

/* 

) 

/* 

return (width)? 

/* 

) 

/* 


find width of field to hold "count" */ 
INPUT: frequency of letter */ 

result — start at 1 for underflow */ 

loop 'til all bits discarded */ 

counting the bits... */ 

...and chuck out one more */ 
end of loop counting bits */ 
that's the answer */ 
end of fieldwidth() */ 


/**** makeuf — Make the "underflow" signature. +++*/ 

/* The underflow signature is the only bit signature which doesn't 

correspond to a word or phrase. Instead, it has the bit just ABOVE 
each letter's count field set. If too many letters are subtracted 
from a field in a real bit signature, the underflow bit to the left 
of that field will be set, and ANDing the now-bogus signature with 
the "underflow" signature will yield a nonzero result, indicating 
underflow. */ 
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makeuf (freqs, letmask, letbit, letwidth) 

int freqs []; /* INPUT: the phrase's frequency table */ 

int letmask [], letbit [], letwidthf]?/* INPUT: mask #, bit #, field 

width */ 

/* GLOBAL OUTPUT: uflosig */ 

( 

int 1? /* letter number */ 

int bnum, bwidth; /* bit number, field width */ 


for (1=0? 1 <= MAXMASKS? 1++) 
uflosig (1] = 0? 


/* to start with, clean out... */ 

/* ...each bitmask in the underflow 
sig V 


for (1 = o? 1 < 26? 1++) /* loop through all 26 letters */ 

if (freqs [1] != 0) /* did this letter occur in the phrase? */ 

{ /* yes: it has a field */ 

bnum = letbit [1)? /* get the starting bit for the field */ 

bwidth * letwidth [1]?/* and get the field's width */ 

/* Note that we must use "1L", not just "1" — these are 
longwords. */ 

uflosig [letmask [1]] += /* take letter's mask from the sig... */ 

(1L « (bnumfbwidth-1))?/* ...and put the underflow bit in */ 

> /* end of handling letter in phrase */ 

) /* end of makeuf() */ 

/**** makeonesig — Create the bit signature for a string. ****/ 
makeonesig (str, sig) 

register char *str? /* INPUT: string to analyze */ 

register bitmask sig[)? /* OUTPUT: signature for string */ 

/* GLOBAL INPUT: letmaskf] and letbit[] */ 

( 

register int 1? /* letter number (and loop counter) */ 

int sfreqs [26]? /* frequency distribution for "str'' */ 

register bitmask fr? /* one frequency, shifted into position */ 


makefreqs (str, sfreqs)? /* create a frequency table for string */ 


for (1 = 0? 1 <= lastmask? 
sig[l] = 0? 


1++) /* go through all used bitmasks... */ 
/* ...initializing their signature */ 


for (1 = 0? 1 < 26? 1++) 
if (sfreqs [1]) 

{ 

fr = ((bitmask) sfreqs [1]) 
sig [letmask [1]] +* fr? 


/* loop through all letters */ 

/* does this letter occur? */ 

/* yes: want to add into its mask 
<< letbit [1]? /* shift freq -> 
position */ 

/* and add into the right mask */ 
/* end of adding in letter frequency */ 

/* end of makeonesig() */ 


/★*** usable — See if a string is 
int usable (str) 

register char *str? 

/* GLOBAL INPUT: frequency table 

( 

register int 1? 
register char c? 
int sfreqs [26]? 


usable? return 0 if not. ****/ 

/* returns zero on failure */ 

/* INPUT: string to analyze */ 

V 

/* letter number */ 

/* character from the string */ 
/* string's frequency profile */ 


if (*str «= *\0') return (0)? /* null string is no good */ 


/* We could use makefreqs() here, 
word before we build its whole 
faster. */ 

for (1 ■ 0? 1 < 26? 1++) 
sfreqs [1] « 0? 


but we'll usually disqualify the 
frequency table, so this way is 

/* loop through all letters... */ 
/* ...zeroing their frequency */ 


while (c = *str++) 
( 

c -= 'a•? 
if (-f+sfreqs [c] 
return (0)? 

) 


/* pick up all characters in str... */ 

/* convert each one from a..z to 0..25 */ 

> freqs[c]) /* tally up their count */ 

/* ...and see if there are too many */ 

/* end of loop through string's letters */ 


return (1)? 
I 


/* we're OK — say so */ 
/* end of usable() */ 


/**** getwords — Read in and count all the usable words. ****/ 

/* The dictionary may be packed: each word is prefixed with an ASCII 
count of the number of letters in common with the previous word. 

Note that if there are no such prefixes (i.e., it's not compressed), 
the routine works fine anyway. */ 


• int words () 

( 


continued 
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FILE *dictfile? 

char inpline [STRMAX); 

char lastline [STRMAX]? 

char *inp? 

int common; 

char word [STRMAX]? 

long wordsread * 0? 


/* the dictionary file */ 

/* raw input line (still compressed) */ 
/* last line read (after unpacking) */ 

/* input line pointer */ 

/* # of letters in common w/last word */ 
/* word rebuilt from packed diet */ 

/* word count, to give some feedback */ 


numwords =0? /* no words yet */ 

printf ("Reading dictionary...")? /* explain this unavoidable delay */ 
dictfile - fopen ("dictionary", "r") ? /* open dictionary? 

assume success */ 

fseek (dictfile, 0L, 0); /* reset to start of file */ 
while (1) /* EOF is noticed in mid-loop */ 

* if (fgets (inpline, STRMAX, dictfile) =« NULL) /* get a word */ 
break; /* if end-of-file, quit */ 

inpline [strlen(inpline)-1] = ' \0' ? /* strip off trailing newline */ 


common =0? /* initially, no letters in common */ 

inp = inpline; /* point to start of input line */ 

while (isdigit (*inp)) /* process digits... */ 
common = (common * 10) + (*inp++ - *0')? 

/* ...accumulate number */ 

lastline [common] = »\0'? /* take first N chars of previous line */ 
streat (lastline, inp); /* and add the rest to create this word */ 


strepy (word, lastline)? 
clean (word)? 
if (usable (word) != 0) 
storeword (lastline)? 
if ((++wordsread % 1000) 

) 

putch ('\n'); 


/* remember uncleaned word for next time */ 
/* clean up punctuation, etc. */ 

/* can it be used in anagrams? */ 

/* yes: store the UNcleaned version */ 

== 0) putch (*. 1 ) ? 

/* whistle while we work */ 

/* end of loop through diet */ 

/* finish off the line of dots V 


if (numwords =» 0) /* NOTHING found? */ 

die ("Sorry — absolutely NO usable words foundi\n")? 
printf ("%d usable words found.\n", numwords); 

/* hint at size of output V 

) /* end of getwords() */ 


/**** storeword — Store a word ****/ 

/* Because many malloc() routines are slow or space-greedy we batch up 
words and store them in large buffers, allocating buffers 
when needed. */ 


storeword (word) 

register char *word; /* word to stash V 

register char *memword? /* allocated word */ 

register int len = 1 + strlen (word)? /* size we need to store word V 
register int size; /* size of new chunk */ 

/* Decide if the current buffer has enough room for the word. */ 
if (len > textleft) /* no room in current text chunk? */ 

if ((textnext * malloc (textleft = 5000)) 

/* reset size and allocate */ 

**« NULL) /* did we fail? */ 

die ("Sorry — not enough memory for this anagram!\n")? 


memword ** textnext? 
textnext += len? 
textleft — len? 
strepy (memword, word)? 


/* allocate at first free character */ 

/* next time, alloc after this word... V 
/* ...and debit free length in chunk V 
/* store the word in the new chunk */ 


/* Store the word's pointer in the dynamic array "wordlist". V 
if ((nurawords+1) >- maxwords) 

/* would this overflow the current list? */ 


maxwords +- 512? /* jump to next size V 

size ** maxwords * sizeof (char *) ; 

/* find new array size, in bytes */ 


if (wordlist ==■ NULL) /* no list yet? */ 
wordlist = (char **) malloc (size)? 

/* 1st time: allocate the block V 
else wordlist = (char **) realloc (wordlist, size)? 

/+ grow the block */ 


if (wordlist — NULL) /* blew it? V 

die ("Sorry — not enough memory for this anagraml\n")? 

/* end of handling list overflow V 


wordlist [numwords++] - memword; /* store this word in the list */ 

/* end of storeword() V 
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/**** makeallsigs — Make signatures for each word we saved 
earlier. ****/ 

/* Note that "lastmask" may not be as large as MAXMASKS—in other words, 
we don't always use full-sized signatures. To save memory, we 
allocate them only as large as needed. Thus some pointers which 
ought to be declared as *bitsig are declared as *bitmask and 
incremented by (lastmask+1) units instead of a simple "++" . */ 


makeallsigs() 

/* GLOBAL INPUT: numwords, wordlist[] */ 

/* GLOBAL OUTPUT: wordsigs[] */ 

{ 

int i; /* one more loop index */ 

int size; /* size of all bit signatures */ 

bitmask *sigp; /* pointer into array of bitsigs */ 

char wordcopy [STRMAX]; /* working copy of a saved word */ 

size = numwords * (lastroask+1) * sizeof (bitmask)? 

/* size of all sigs */ 

wordsigs = (bitmask *) malloc (size);/* allocate space for it */ 
if (wordsigs — NULL) /* blew it? */ 

die ("Sorry — not enough memory for this anagram!\n"); 

/* Loop through the words; generate and save each one's signature. */ 
sigp = wordsigs; /* point to the first signature 

slot */ 

for (i = 0; i < numwords; i++) /* loop through every word... */ 

( 

strcpy (wordcopy, wordlist [i]);/* ...copy the word */ 
clean (wordcopy); /* ...clean it up */ 

makeonesig (wordcopy, sigp); /* ...make and store its signature */ 

sigp +* (lastmask+1); /* ...and bump to next word's slot */ 

) /* end of loop through usable words */ 

) /* end of makeallsigs() */ 

/**** findanagrams — Recursively search for complete anagrams. ****/ 

/* We're passed a node, which may be the complete phrase or the 

phrase with some letters already removed. We're also given the last 
word used, so we can print each permutation in only one order. 

The main loop tries all words from the current word to the last one. 
Each word is "subtracted" from a copy of the current node. If the 
result underflows, we skip the word. Otherwise, we push it on our 

stack. If the result of the subtraction is exactly an empty 
signature (all zero), then we've generated an anagram and can print 
it. Otherwise we recurse, passing the selected word as the current 
word, and the new, reduced signature as the current node. 

The code to subtract masks is combined with the checks for underflow 
andzero results in a cascaded "switch" which breaks as soon as it 
sees an underflow. The cases in the switch are nearly identical, and 
are built with the DOMASK macro. If none of the cases detect 
overflow, the lastcase falls into processing for a successful 
subtraction. */ 


Odefine DOMASK(MASK) { /* one case of switch */ \ 

newmask = curnode [MASK] - cursig [MASK];/*subtract from anagram*/ \ 
if (newmask & uflosig [MASK])/* did the subtraction underflow? */ \ 

break; /* yes: break switch & do next word */ \ 

newsig [MASK] « newmask; /* it's OK; store it */ \ 

bitsleft |« newmask; /* note if there are any bits left */ ) 


findanagrams (curword, curnode) 

register int curword; /* current word number (used in loop) */ 

register bitmask *curnode; /* bit signature for current node */ 

{ 


bitsig newsig; 
register bitmask newmask; 
register bitmask *cursig; 
register long bitsleft; 


/* the new signature (next node down) */ 
/* a single bitmask from new signature */ 
/* current word's signature */ 

/* flag: nonzero if not all letters used */ 


cursig ■ &wordsigs [curword * (lastmask+1)]; 

/* get signature for word */ 


while (curword < numwords) 
( 

bitsleft * 0; 
switch (lastmask) 

( 

case 2: D0MASK(2) 
case 1: DOMASK(1) 
case 0: DOMASK(0) 


/* loop through all words after this one*/ 

/* no remaining bits seen yet */ 

/* check only used masks in signature */ 

/* handle the 3rd mask, if there is one */ 

/* handle the 2nd mask, if there is one */ 

/* handle the 1st mask, if there is one */ 


continued 
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/* We didn't break, so no underflows occurred. Print or recurse. */ 


/* 


) 


*anaptr++ = wordlist [curword]; 


/* stack word for printing/recursing */ 
Decide whether the anagram is complete or if we must search 


deeper. */ 
if (! bitsleft) 
printanagram(); 
else findanagrams 


—anaptr? 


/* no bits left in the signature? */ 

/* yes: used up all letters! print it */ 
(curword, newsig)? 

/* nope: climb down to subnode */ 

/* discard the word from the stack */ 

/* end of switch to subtract and process */ 


curword++; /* advance to next word's number... */ 

cursig += (lastmask+1); /* ...and to next word's bit signature */ 

/* end of loop through words */ 


) 


/* end of findanagrams() */ 


/**** printanagram — Print an anagram stored on the recursion 
stack. ♦***/ 

printanagram() 

* register char **wp; /* roving pointer for climbing stack */ 

char response [STRMAX]? /* response for when we pause */ 


for (wp = anawords? wp < 

printf ("%s ", *wp); 
printf ("\n")? 


anaptr; wp++) 

/* go through the whole stack */ 

/* print each word, separated by blanks */ 
/* kick to a new line after anagram */ 


if ((++anacount % SCRLEN) «= 0)/* are we at the end of a screenful? */ 
{ /* yes: time to pause */ 

printf (" Press return to continue; anything else to quit..."); 
gets (response); /* see what they want */ 

if (strlen (response) != 0) exit(); 

/* quit if they typed anything */ 

) /* end of periodic pause */ 

) /* end of printanagram() */ 


/**** die — Print the passed message and call it quits: ****/ 
die (s) 

char *s; /* dying words */ 

( 

printf ("%s", s); /* help out the user... */ 

exit(); /* and skip town */ 

) /* end of die() */ 


TM1.BAS accompanies, "The Turing Machine," by Isaac Malitz, November, 1987, 
page 345 


1 REM TM1 — EASY TM SIMULATOR 

199 REM TAPE 

200 T$="XXXXXbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" 

210 S$= s "0": REM STARTING STATE « 0 

220 P=l:REM STARTING POSITION ON TAPE « 1 
400 PRINT:PRINT T$ 

410 PRINT TAB(P);" A ":REM POSITION OF READ-WRITE HEAD 
420 IF S$ - THEN END 

499 REM L.500 - 520 DOES STATE TABLE LOOKUP 

500 M$= S$ + MID$(T$,P,1) 

510 RESTORE 

520 READ R$:IF MID$(R$,1,2) <> M$ THEN 520 
600 PRINT:PRINT S$,R$ 

610 INPUT "",X 

799 REM REWRITE SYMBOL ON TAPE 

800 MID$(T$,P,1)=MID$(R$,4,1) 

819 REM MOVE LEFT ON TAPE 

820 IF MID$(R$,6,1)«"L" THEN P=P-1 

829 REM MOVE RIGHT ON TAPE 

830 IF MID$(R$,6,1)="R" THEN P=P+1 

840 S$=MID$(R$,5,1):REM DETERMINE NEW STATE 
900 GOTO 400 

2000 DATA "OX-blR","Ob-E.." :REM STATE 0 
2010 DATA "lX-bOR","lb-0.." :REM STATE 1 
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DENCH.PAS Accompanies "Marshal Pascal and Pascal-2by Mark Bridger, BYTE, 
December 1987, page 185 


program SIEVE(INPUT,OUTPUT)? 
const 

size = 8190? 

var 

flags: array(0..size] of boolean? 
I, prime, K, count, iter: integer? 
begin 
readln? 

for iter:= 1 to 10 do 
begin 

count0? 

for I:- 0 to size do 
flags[I]:« true? 
for I:= 0 to size do 
if flags[I] 
then 
begin 

prime:*** I + I + 3? 
k:= I + prime? 
while K <= size do 
begin 

flags[K] : = false? 

K:* K + prime? 
end? 

count:** count + 1 
end? 

writeln(count,' prices.')? 
end? 

writeln(chr(7)) (Beep) 
end. 


program CALC(input,output)? 
var A,B,C: real? 

N, I: integer? 
begin 
readln? 

N:= 5000? 

A:** 2.71828? 

B:= 3.14159? 

C:« 1? 

For I:- 1 to N do 
begin 

C:» C * A? 


C:« C * B? 

C:- C/A? 

C:« C/B 
end? 

write(chr(7))? 
writeln('Error « C - 
end. 


1 ) 


program FLOATER(INPUT,OUTPUT)? 
var I: integer? 

x,y: real: 
begin 
readln? 
x:* 1? 

for I:- 1 to 1000 do 
begin 

y:- sin(x)? 
y:“ ln(x)? 
y:- exp(x)? 
y:= sqrt(x)? 
y:- arctan(x)? 
x:- x + 0.01 
end? 

write(chr(7)) ? 
end. 


continued 
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{ Turbo Pascal version of trans.pas ) 
program TRANS; 
var 

F,G: file of byte; 
ch: byte; 
begin 
readln; 

assign(F, 'infile.txt')? 
assign(G, 'outfile.txt'); 
reset(F); rewrite(G); 
while not(EOF(F)) do 
begin 

read(F, ch); 
write(G, ch) 
end? 

close(F); close(G)? 
write(chr(7))? (Beep) 
end. 

{ Standard Pascal version of Trans.pas ) 
program TRANS(Input,Output); 
var 

F,G: text; 
ch: char? 
begin 
readln; 

reset(F, 'infile.txt'); 
rewrite(G, 'outfile.txt')? 
while not(EOF(F)) do 
begin 

read(F, ch)? 
write(G, ch) 
end ? 

close(F); close(G); 
write(chr(7)); (Beep) 
end. 


( Before running heaptest under Marshal Pascal be sure a specify the large heap 

program heaptest(input,output); 

const 

AbsoluteMaxSize ■ 60? 
type 

Strings = array(1..9999] of char? 

BufferType - ^Strings? 

var 

Buffer: array(0..AbsoluteMaxSize] of BufferType; 

MaxSize, I: integer; 


begin 

write('Enter number of pointers: '); 
readln(MaxSize)? 

for I:« 1 to MaxSize do new(Buffer[I]); 


dispose(Buffer[MaxSize])? 

for I:- 1 to (MaxSize - 1) div 

new(Buffer[MaxSize]); 

for I:- 1 to (MaxSize - 1) div 

for I:= 1 to (MaxSize - 1) div 

dispose(Buffer[MaxSize]); 

new(Buffer[0])? 

for I:- 1 to (MaxSize - 1) div 
write(chr(7))? 
end. 


2 do dispose(Buffer[2*I]); 

2 do new(Buffer[2*I])? 

2 do dispose(Buffer(2*1 - 1]); 

2 do new(Buffer[2*I - 1])? 


PR0J3D.BAS Accompanies "Three-Dimensional Perspective Plotting," by Tyrone Dault 


REM ******************************************************** 

REM * Three Dimension Plotting Program 

REM * Cartesian Coordinates 

REM * Version 5.1M 

REM * by Tyrone Louis Daulton October 1986 

REM * Washington University in St. Louis 

REM * Department of Physics 

REM * 
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REM * Microsoft Basic Verison 2.1 
REM * for Apple Macintosh 

REM * This is a streamlined general purpose Cartesian Plotting program. 

REM * This program is fully menu driven. 

REM ******************************************************** 

DIM T (3,3),T1(3,3),T2(3,3) : REM Dimension Transformation Arrays 

DIM N(3) : REM Dimension Coordinate Array 

DIM POLY%(12) ,PATT%(3) : REM Dimension Quick Draw Graphic Arrays 

PI-3.141592654# : REM Value of pi 

RESOLUTION-2.5 : REM Size of grid "squares" 

REM BEGIN MAIN PROGRAM 

REM * Menu Creation (Program overhead) 

MENU 1,0,1,"Control" 

MENU 1,1,1,"Stop": MENU 1,2,1,"Start" 

MENU 2,0,1,"Grid Points" 

MENU 2,1,1," 100":MENU 2,2,1," 156" 

MENU 2,3,1," 204":MENU 2,4,1," 277" 

MENU 2,5,1," 400":MENU ..2,6,1," 625":MENU 2,7,1," 800" 

MENU 2,8,2,"1040":MENU 2,9,1,"1200":MENU 2,10,1,"1600":MENU 2,11,1,"1800" 

MENU 2,12,1,"2500":MENU 3,0,1,"Hidden Lines" 

MENU 3,1,2,"Solid Sheet":MENU 3,2,1,"Fish Net" 

MENU 4,0,1,"Grid Pattern":MENU 4,1,2,"White": MENU 4,2,1,"Black":MENU 4,3,l,"Gra 
MENU 5,0,1,"Screen":MENU 5,1,2,"White": MENU 5,2,1,"Black" 

LEAVE=0 

RESOLUTION=3.1 
MENU ON 

ON MENU GOSUB MENUCHECK 

IDLE: IF LEAVE-1 THEN CONTINUEON 
GOTO IDLE 

MENUCHECK: 

MKNUNUMBER-MENU(0):MENUITEM-MENU(1) 

IF MENUNUMBER-1 AND MENUITEM-2 THEN BLOCK1 ELSE BLOCK1A 
BLOCK1: LEAVE-1: GOTO ENDOFSUB 

BLOCK1A: IF MENUNUMBER-1 AND MENUITEM-1 THEN END 
IF MENUNUMBER-3 THEN BLOCK2 ELSE BLOCK3 
BLOCK2: IF MENUITEM-1 THEN DOl ELSE D02 

DOl: MENU 3,1,2 : MENU 3,2,1: MENU 4,0,1:SSFLAG-0: GOTO ENDOFSUB 
D02: MENU 3,1,1: MENU 3,2,2: SSFLAG-1:MENU 4,0,0:GOTO ENDOFSUB 
BLOCK3: IF MENUNUMBER-2 THEN D03 ELSE BLOCK4 
D03 : 

BLOCK4: IF MENUNUMBER-2 THEN BLOCK5 ELSE BLOCK6 

BLOCKS: REM * assign resolution to appropriate number of grid points 
IF MENUITEM-1 THEN RESOLUTION =10 
IF MENUITEM=2 THEN RESOLUTION-8 
IF MENUITEM-3"THEN RESOLUTION-7 
IF MENUITEM-4 THEN RESOLUTION-6 
IF MENUITEM-5 THEN RESOLUTION-5 
IF MENUITEM-6 THEN RESOLUTION-4 
IF MENUITEM-7 THEN RESOLUTION-3.53 
IF MENUITEM-8 THEN RESOLUTION-3.1 
IF MENUITEM-9 THEN RESOLUTION-2.89 
IF MENUITEM-10 THEN RESOLUTION-2.5 
IF MENUITEM-11 THEN RESOLUTION-2.36 
IF MENUITEM-11 THEN RESOLUTION-2 
FOR A—1 TO 12 : MENU 2,A,1 : NEXT A 
MENU 2,MENUITEM,2 

BLOCK6: IF MENUNUMBER-4 THEN BB ELSE BL0CK7: 

BB: IF MENUITEM-1 THEN pat-0 : GOTO EN 

IF MENUITEM-2 THEN : pat—1: GOTO EN 
IF MENUITEM-3 THEN : pat-84! 

EN: FOR A-l TO 3 :MENU 4,A,1: NEXT A : MENU 4,MENUITEM,2 
BLOCK7: IF MENUNUMBER-5 THEN BC ELSE ENDOFSUB: 

BC: IF MENUITEM-1 THEN MENU 5,1,2: MENU 5,2,1 : SCREA-0 

IF MENUITEM-2 THEN MENU 5,2,2: MENU 5,1,1 : SCREA—1 

FOR A-0 TO 3: PATT%(A)-SCREA: NEXT A: CALL BACKPAT(VARPTR(PA 

CLS 

ENDOFSUB: 

RETURN 

CONTINUEON: 

MENU 1,1,1: MENU 1,2,0 

MENU 2,0,0:MENU 3,0,0:MENU 4,0,0:MENU 5,0,0 
ON MENU GOSUB MENUCHECK2: 

INPUT" Vantage Point (X,Y,Z) ",VX,VY,VZ : REM Vantage Point 
CALL Quadrant(VX,VY,Quad) 

CALL Configuration(VX,VY,VZ) : REM Construct Rotation transfor 

CALL PLOT : REM Plot the function 

MENUCHECK2:END 
STOP 


continued 
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H !l * * ****************************************************** 

MIIM IM.«IT MTATIC 

HAMI D SXO, SYO, Beta , T () , M, RESOLUTION, VR,I,J,PI,T1() ,T2() ,POLY%() ,PATT%() 

CIh'5: 

REM {NX, NY, NZ) True coordinate syst 
REM {STX, STY) Screen coordinate syst 

DIM IIOLDX (4 ) , HOLDY (4) : REM Arrays to hold four image points* coordinates 

X 0 : Y-0 : Z=50 

IF pat=-l THEN COL=30 ELSE COL=33 
REM PLOT X,Y,Z AXIS 

IF SCREA=*-1 THEN COLOR=30 ELSE COLOR=3 3 
CALL Transformation(X,Y,Z,STX,STY) 

LINE(SXO,SYO)-(STX,STY),COLOR 
X=50 : Y=0 : Z=0 

CALL Transformation(X,Y,Z,STX,STY) 

LINE(SXO,SYO)-(STX,STY),COLOR 
X=0 : Y=50 : Z=0 

CALL Transformation(X,Y,Z,STX,STY) 

LINE(SXO,SYO)-(STX,STY),COLOR 

REM Calculate which quardrant to start plotting ( needed for hidden line removal 
NYlosign-1:NYhisign=l:NXlosign=l:NXhisign=l:ressignx=l:ressigny=l 

IF Quad=l THEN 1 ELSE 2 

1 : NYlosign=-l : NXlosign=-l 

2 : IF Quad=2 THEN 3 ELSE 4 

3 : NYlosign=-l: NXhisign=-l:ressignx=-l 

4 : IF Quad=3 THEN 5 ELSE 6 

5 : NYhisign=-l : NXhisign=-l:ressignx=-l:ressigny=-l 

6 : IF Quad=4 THEN 7 ELSE 8 

7 : NYhisign=-l:NXlosign=-l:ressigny=-l 

8 : 

FLAG=0 : STX1«121 : STY1=50 

FOR NY=NYlosign*50 TO NYhisign*50 STEP RESOLUTION*ressigny 

FOR NX=NXlosign*50 TO NXhisign*50 STEP RESOLUTION*ressignx 
REM Construct the plot grid 

GOSUB FUNCTION ; REM Calc 

CALL Transformation(NX,NY,NZ,STX,STY): REM Transform to screen coordinat 
PS ET(STX,STY) 

IF NX=NXlosign*50 THEN BELOW ELSE GOON 

BELOW: NY=NY+RESOLUTION*ressigny: REM Calculate first pair of points 
GOSUB FUNCTION: REM Calculate NZ 

CALL Transformation(NX,NY,NZ,STX2,STY2): REM Transform to screen coordin 
PSET(STX2,STY2) 

NY=NY-RESOLUTION*ressigny: REM Reset to current point in for loops 
HOLDX(1)=STX:HOLDX(2)=STX2: REM Remember point 
HOLDY(1)=STY:HOLDY(2)=STY2: REM Remember point 
NX=NX+RESOLUTION*ressignx 

GOON: 

GOSUB FUNCTION : rem Ca 

CALL Transformation(NX,NY,NZ,STX2,STY2): REM Transform to screen coordin 
PSET (STX2,STY2) 

HOLDX(3)=STX2:HOLDY(3)=STY2: REM Remember point 
NY=NY+RESOLUTION*ressigny 

GOSUB FUNCTION: REM Calculate NZ 

CALL Transformation(NX,NY,NZ,STX2,STY2): REM Transform to screen coordin 
PSET (STX2,STY2) 

HOLDX(4)=STX2:HOLDY(4)=STY2: REM Remember point 

NY=NY-RESOLUTION*ressigny: REM Reset to current point in for loops 

CALL SOLIDSHEET(HOLDY(1),HOLDX(1),HOLDY(2),HOLDX(2),HOLDY(3),HOLDX(3),HO 
HOLDX(1)=HOLDX(3):HOLDY(1)=HOLDY(3): REM Remember first pair 
HOLDX(2)=HOLDX(4):HOLDY(2)=HOLDY(4): REM Remember first pair 
NEXT NX 

NEXT NY 
GOTO JUMPER 

REM Gosub routine to calculate NZ 
FUNCTION: 

NZ=COS( (NX A 2+NY A 2)/600*PI)*60: REM Insert Function Here <— 

IF NZ<0 THEN NZ=NZ/2 

IF (NX A 2+NY A 2)>900 THEN NZ=0 

RETURN 

JUMPER: 

END SUB 


REM ******************************************************** 
SUB Transformation(XI,X2,X3,STTX,STTY) STATIC 
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SHARED T(),VR,SXO,SYO # Beta,I,J 

REM N(1)=X point N(2)=Y point N(3)=Z point 


REM Rotate the coordinate axis with rotation transformation 
REM In other words transform true coordinates to proper coordinates 
N (1)=X1:N(2)=X2:N(3)=X3 
FOR 1=1 TO 3 
NR(I)=0 
FOR J=1 TO 3 

NR(I)=NR(I)+T(I, J)*N(J) 

NEXT J 

NEXT I 


RDTP=VR-NR(1) :REM This is the distance to the point if its y,z=0 

IF RDTP<0 OR RDTP=0 THEN ohno ELSE Contin 

ohno: 

REM The point is at the viewer's location or it is behind the viewer 
REM The point can not be plotted 
REM An error occurs 
STOP 

Contin: 

REM : Transform proper coordinates into adjusted screen coordinates 
TanThetasx=NR(2)/RDTP 
TanThetasy=NR(3)/RDTP 
SX=SXO*TanThetasx/TAN(Beta) 

SY=SXO*TanThetasy/TAN(Beta) 

REM: Transform adjusted screen coordinates into screen coordinates 
STTX=SX0+SX:STTY=SY0-SY 
END SUB 


R EM***** **************************************************** 

SUB Configuration(VX,VY,VZ)STATIC 

SHARED PI,T(),T1(),T2(),PI,Beta,RS,SXO,SYO,VR,VRpolar, I, J 

REM T2 is the rotation matrix about the z axis 
REM T1 is the rotation matrix about the y axis 

Beta=PI/4 : REM Angle the window subtends 

RS=10 : REM Distance viewer is away from window 

SX0=250 : REM 1/2 screen size in x direction 

SY0=150 : REM 1/2 screen size in y direction 

FOR 1=1 TO 3:FOR J=1 TO 3:T1(I,J)=0:T2(I,J)=0: NEXT J,I: REM Zero Arrays 

REM Calculate needed values 
VR=SQR( (VX)*2 + (VY) A 2 + (VZ) A 2 ) 

VRpolar=SQR( (VX) A 2 + (VY) A 2 ) 

REM Create the two rotation transformation matrices 
FOR 1=1 TO 3: FOR J=1 TO 3:T1(I,J)=0:T2(I,J)=0: NEXT J,I 
T2(1,1)=1:T2(2,2)=1:T2(3,3)=1 
IF VRpolar=0 THEN SKIProtation 
T2(l,1)=(VX)/VRpolar 
T2 (1,2) = (VY)/VRpolar 
T2(2,1)=-T2(1,2) 

T2(2,2)=T2(1,1) 

SKIProtation: 

T1(1,1)=VRpolar/VR 
T1(1,3)=(VZ)/VR 
T1(2,2)=1 
T1(3,1)=-Tl(1,3) 

T1(3,3)=T1(1,1) 

REM : Multiply the two matrices together 

FOR 1=1 TO 3 

FOR J=1 TO 3 

T(I, J)=0 

FOR K=1 TO 3 

T(I,J)=T(I,J)+T1(I,K)*T2(K, J) 

NEXT K, J, I 
END SUB 


REM ********************************************************* 
SUB SOLIDSHEET(A1,B1,A2,B2,A3,B3,A4,B4,COL)STATIC 
SHARED POLY%(),PATT%(),SSFLAG,pat,SCREA 


continued 
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REM This subroutine uses the quick draw machine routines 
CALL PENNORMAL 
CALL SHOWPEN 

POLY%(0)=26 

POLY%(1)=0 : POLY%(2)—0 : POLY%(3)=500 : POLY%(4)=250 
POLY%(5)=A1 : POLY%(6)=Bl : POLY%(7)=A2 : POLY%(8)=B2 
POLY%(9)=A4 : POLY%(10)=B4 : POLY%(11)=A3: POLY%(12)=B3 
FOR A=0 TO 3 : PATT%(A)=pat : NEXT A 

IF SSFLAG-0 THEN CALL FILLPOLY(VARPTR(POLY %(0)),VARPTR(PATT%(0))) 
CALL FRAMEPOLY(VARPTR(POLY%(0))) 

LINE(B1,A1)-(B3,A3),COL: LINE(B2,A2)-(B4,A4),COL 
LINE(B1,A1)-(B2,A2),COL: LINE(B3,A3)-(B4,A4),COL 
END SUB 


REM********************************************************** 


SUB Quadrant(VX,VY,Quad)STATIC 
IF VX>0 AND VY>0 THEN Quad=l 
IF VX<0 AND VY>0 THEN Quad-2 
IF VX<0 AND VY<0 THEN Quad=3 
IF VX>0 AND VY<0 THEN Quad=4 
END SUB 


ENTROPY.BAS Accompanies "Information Theory" by Ramachandran Bharath, BYTE, 
December, 1987, page 291 


10 REM ENTROPY.BAS FOR IBM PC AND COMPATIBLES 

15 REM THIS PROGRAM WAS DEBUFFED AND STREAMLINED BY PROF JUNE PARSONS OF NMU 
20 CLS 

30 DIM S$(40),PROB(40) 

40 LET ENTROPY - 0 

50 INPUT "How many different symbols are there in your alphabet ? ", NUMBER 
60 PRINT 

70 FOR INDEX - 1 TO NUMBER 

80 PRINT "Type in symbol # "; INDEX ? " and relative frequency. Separate" 

90 PRINT " the two using a comma. (REMEMBER , RELATIVE FREQUENCIES " 

100 PRINT "MUST ADD UP TO 1.00) " 

110 INPUT S$(INDEX),PROB(INDEX) 

120 ENTROPY ■ ENTROPY + PROB(INDEX)*LOG(1/PROB(INDEX) ) 

130 NEXT INDEX 

140 REM ENTROPY CALCULATIONS USE LOGS TO THE BASE 2 
150 LET ENTROPY = ENTROPY/LOG(2) 

160 PRINT 

170 PRINT "Entropy is ", ENTROPY 

180 PRINT : PRINT 

190 PRINT "Symbol","Probability" 

200 FOR INDEX - 1 TO NUMBER 
210 PRINT S$(INDEX),PROB(INDEX) 

220 NEXT INDEX 
230 END 


CARTOG.PAS Accompanies "Mapping the World in Pascal" by Robert Miller and 
Francis Reddy, BYTE, December 1987, page 329 


PROGRAM Cartog? 

{ This program plots geographic data from the file 
WORLD.DAT and coordinate grids on the Mercator, 
Equidistant Cylindrical, Sinusoidal, Hammer, and 
Orthographic map projections. 

) 


CONST Sqrt2 
PI 

HalfPI 

TwoPI 

Radian 

RadianDivlOO 


1.4142135623731; 

3.1415926535898; 

1.5707963267949; 

6.2831853071796? 

1.7453292519943E-2; 

1.7453292519943E-4 ? ( PI/180/100, needed to convert ) 
< data in WORLD.DAT to radians ) 


CONST XCENTER 
YCENTER 


: INTEGER » 320? 
: INTEGER - 99; 


{ CGA Graphics constants. ) 

{ Screen center X and Y ) 


i 
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ASPECT : 

REAL “ 2.4; { 

640x200 aspect 

ratio 

) 


R : 

REAL = 40; ( 

Default map radius 

) 


NotVisible : 

INTEGER = -32767; ( 

Flag for point 

visibility 

) 

TYPE 

LLREC 

RECORD 





CODE : 

ARRAY[0... 13 OF CHAR; 





LONGI, LATI: 

INTEGER; END; 




VAR 

LL : 

LLREC; 





LLF : 

FILE OF LLREC; 




VAR 

LastX, LastY 

, XP, YP : INTEGER; { 

Save variables 

for plotting ) 



COLOR GLB 

: INTEGER; 





VAR I, J, K, MapType, M, XI,Yl, 

X2, Y2, SX, SY, CENTER : INTEGER; 


VAR L, LI, LONGR, LSTEP, 

B, LATR, BSTEP, X, Y, 

PHI1, LambdaO : REAL; 

VAR XX, YY, SA, SB : REAL; 


VAR LastPtVis, GRID 
VAR CH 


BOOLEAN- 

CHAR; 


FUNCTION ArcCos(X: REAL): REAL; 

BEGIN 

IF ABS(X) < 1 THEN ArcCos:= 
ELSE IF X = 1 THEN ArcCos:= 
ELSE IF X ~-l THEN ArcCos:= 
END; { ArcCos. ) 


ARCTAN(SQRT(1-SQR(X))/X) 
0 

Pi; 


FUNCTION ArcSin(X: 
BEGIN 

IF ABS(X) < 1 
ELSE IF X ■ 1 
ELSE IF X —1 
END; { ArcSin. ) 


REAL): REAL 

THEN ArcSin 
THEN ArcSin 
THEN ArcSin 


= ARCTAN(X/SQRT(1-SQR(X))) 
= HalfPI 
—Half PI; 


FUNCTION ArcTanH(X : Real): Real; 

VAR A,T : REAL; 

BEGIN 

T:=ABS(X); 

IF T < 1 THEN 
BEGIN 

A :* 0.5 * LN((1 + T)/(1 - T)); 

IF X < 0 THEN ArcTanH : = -A ELSE ArcTanH :=A; 
END; 

END; { ArcTanH. ) 


FUNCTION Meridian(Lambda, LambdaO: REAL):REAL; 

( Returns difference between current longitude and map center. ) 

VAR DelLam : REAL; 

BEGIN 

DelLam :« Lambda - LambdaO; 

IF DelLam < -PI THEN DelLam := DelLam + TwoPI 
ELSE 

IF DelLam > PI THEN DelLam :« DelLam - TwoPI; 

Meridian:=DelLam; 

END; ( Meridian. ) 

PROCEDURE Mercator(Lambda, LambdaO, Phi, R : REAL; VAR X, Y : REAL); 

< For R = 1: -Pi <= X <= Pi, -Pi/2 <= Y <=» Pi/2. ) 

CONST MaxLat : REAL - 1.397; (-80 degrees. ) 

{ REAL = 1.483; -85 degrees. ) 

BEGIN 

IF ABS(Phi) < MaxLat THEN 
BEGIN 

Lambda :■ Meridian(Lambda, LambdaO); 

X := R * Lambda; 

Y :** R * ArcTanH(SIN(Phi)); 

END 

ELSE X :*= NotVisible; 

END; { Mercator. ) 

PROCEDURE EquiCyl(Lambda, LambdaO, Phi, Phil, R : REAL; VAR X, Y : REAL); 
{ For R = 1: -Pi <= X <= Pi, -Pi/2 <= Y <= Pi/2. ) 

BEGIN 

Lambda :- Meridian(Lambda, LambdaO); 

X :■ R * Lambda * COS(Phil); 

Y :- R * Phi; 

END; { EquiCyl. ) 


continued 
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PROCEDURE Sinusoidal(Lambda, LambdaO, Phi, R : REAL? VAR X, Y : REAL); 

( For R = 1: -Pi <= X <= Pi and -Pi/2 <= Y <= Pi/2. } 

BEGIN 

Lambda : = Meridian(Lambda, LambdaO)? 

X := R * Cos(Phi) * Lambda ? 

Y := R * Phi; 

END; ( Sinusoidal. ) 

PROCEDURE Hammer(Lambda, LambdaO, Phi, R : REAL? VAR X, Y : REAL); 

( For R ■ is -2«2 <= X <=2«2 and - «2 <= Y <= «2. ) 

VAR K, CosPhi, HalfLambda : REAL; 

BEGIN 

HalfLambda : = 0.5*Meridian(Lambda, LambdaO); 

CosPhi:-COS(Phi)? 

K :» R * SQRT2 / SQRT(1 +CosPhi * COS(HalfLambda)); 

X : = 2 * K * CosPhi * (SIN(HaIfLambda)); 

Y := K * SIN(Phi)? 

END; ( Hammer. ) 

PROCEDURE Orthographic(Lambda, LambdaO, Phi, Phil, R: REAL; VAR X, Y : REAL); 
( For R - is -2 <= X,Y <= 2. ) 

VAR CosC, CosL, SinPhil, CosPhil, SinPhi, CosPhi, R2 : Real; 

BEGIN 

Lambda :-Meridian(Lambda, LambdaO); R2:=R+R; 

CosPhil:-COS(Phil)? SinPhil:=SIN(Phil)? 

CosPhi :=COS(Phi)? SinPhi:- SIN(Phi)? 

CosL :-COS(Lambda)*CosPhi; 

CosC :-SinPhil * SinPhi + CosPhil * COSL? 

IF CosC >= 0 THEN 
BEGIN 

X :=R2 * CosPhi * SIN(Lambda); 

Y :=R2 * (CosPhil * SinPhi - SinPhil * COSL); 

END ELSE X:=NotVisible? 

END; ( Orthographic. ) 

PROCEDURE Beep; 

{ Sounds a tone when map is complete. ) 

BEGIN 

Sound(880); Delay(250)? NoSound; 

END; 

PROCEDURE PlotPt(VAR LastPtVis: BOOLEAN); 

{ Draws a line from the last point to the current (XP,YP) if it is visible. ) 
VAR IX,IY; INTEGER? 

LABEL XIT? 

BEGIN 

IX:=ROUND(XP)? IY:=ROUND(YP) ; 

IF LastPtVis THEN DRAW(LastX,LastY,IX,IY,1)? 

LastX:=IX; LastY;=IY; 

LastPtVis:*TRUE? 

XIT: 

END; ( PlotPt. ) 

PROCEDURE CoordinateGrid(OUTLINE: BOOLEAN; MapType: INTEGER); 

CONST LatitudeSpacing = 30? 

Longitudespacing - 30? 

VAR Longitude, Latitude, LatLimit, 

MaxLat, Longlncr, Latlncr : INTEGER? 

VAR LL, PP, A, R2, RA, XN, YN, 

SINDT, COSDT : REAL? 

BEGIN 

CASE MapType OF 


1: 

BEGIN 

MaxLat:*80? 

Longlncr:=360; 

Latlncr:=160; 

END; 

2: 

BEGIN 

MaxLat:=90? 

Longlncr:-360? 

Latlncr:=180; 

END? 

3: 

BEGIN 

MaxLat:=90? 

Longlncr:=360? 

Latlncr:=5 ? 

END; 

4. .5: 
END; 

BEGIN 
( CASE. 

Maxlat:=90? 

Longlncr:=5; 

Latlncr:=5? 

END? 


LL:*0 ? PP:=Phil? 

IF OUTLINE THEN 
BEGIN 

IF MapType * 5 THEN PP:*0; 

LatLimit:“MaxLat; ( Draw only extreme latitudes ) 

( to make map outline ) 

END 

ELSE LatLimit:- MaxLat DIV LatitudeSpacing*LatitudeSpacing? 
Latitude:-LatLimit; 

WHILE Latitude >« -LatLimit DO ( Draw parallels ) 

BEGIN 

LATR:-Latitude*Radian? 

LastPtVis:-FALSE? 
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Longitude:—180; 

WHILE Longitude <- 180 DO 
BEGIN 

LONGR:=Longitude*Radian; 


CASE MapType OF 

IS BEGIN MERCATOR(LONGR, LL, LATR, R, X, Y)? END; 
2: BEGIN EQUICYL(LONGR, LL, LATR, PP, R, X, Y)? END; 
3: BEGIN SINUSOIDAL(LONGR, LL, LATR, R, X, Y); END; 
4; BEGIN HAMMER(LONGR, LL, LATR, R, X, Y); END; 


5: BEGIN ORTHOGRAPHIC (LONGR, LL, LATR, PP, R, X, Y)? END? 
END; { CASE...) 

IF X > -300 THEN 
BEGIN 

XP:—ROUND(X*ASPECT)+XCENTER; 

YP:-YCENTER-ROUND(Y)? 

PlotPt(LastPtVis); 

END ELSE LastPtVis:-FALSE; 

Longitude:-Longitude+Longlncr; 

END; 

IF OUTLINE THEN 

Latitude:-Latitude-2*MaxLat 

ELSE 

Latitude:-Latitude-LatitudeSpacing ? 

END; 

IF OUTLINE THEN LL:=0 ELSE LL:=LambdaO; 

Longitude:—180; ( Draw meridians ) 

IF MapType >- 4 THEN MaxLat:-90; 

WHILE Longitude <- 180 DO 
BEGIN 

LONGR:-Longitude*Radian; 

LastPtVis:-FALSE; 

Latitude:-MaxLat; 

WHILE Latitude >- -MaxLat DO 
BEGIN 

LATR:=Latitude*Radian; 


CASE MapType OF 

1: BEGIN MERCATOR(LONGR, LL, LATR, R, X, Y); END; 
2: BEGIN EQUICYL(LONGR, LL, LATR, PP, R, X, Y)? END; 
3: BEGIN SINUSOIDAL(LONGR, LL, LATR, R, X, Y); END; 
4: BEGIN HAMMER(LONGR, LL, LATR, R, X, Y); END; 


5: BEGIN ORTHOGRAPHIC( LONGR, LL, LATR, PP, R, X, Y); END; 
END; ( CASE...) 

IF X > -300 THEN 
BEGIN 

XP:-ROUND(X*ASPECT)+XCENTER; 

YP:-YCENTER-ROUND(Y)? 

PlotPt(LastPtVis); 

END ELSE LastPtVis:-FALSE; 

Latitude:-Latitude-Latlncr; 

END; 

IF OUTLINE THEN 

Longitude:-Longitude+360 

ELSE 

Longitude:-Longitude+LongitudeSpacing; 

END; 

IF OUTLINE AND (MapType-5) THEN 
BEGIN 

A:-0; ( Draw circular outline ) 

LastPtVis:-False; 

R2:-R + R; 

RA:- R2 * Aspect; 

SINDT:- 0.05996400648; 

COSDT:- 0.99820053993; 

X:-l; Y:-0; 

XP:- ROUND(XCENTER + RA); 

YP:- ROUND(YCENTER); 

PlotPt(LastPtVis); 

WHILE A <- TWOPI DO 

BEGIN ( Compute points on the circle ) 

XN:- X * COSDT - Y * SINDT; 

YN:- X * SINDT + Y * COSDT; 


continued 
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X:= XN? Y:- YN? 

XP:= XCENTER + ROUND(X*RA)? 

YP:= YCENTER + ROUND(Y*R2)? 

PlotPt(LastPtVis)? 

A:- A+0.06? 

END? { While. ) 

END? 

END? ( CoordinateGrid. } 

PROCEDURE DrawMap(MapType: INTEGER)? 

VAR Latitude, Longitude : REAL? 

VAR LastX : INTEGER? 

LABEL XIT ? 

BEGIN 

LastPtVis:-FALSE ? LastX:=0? 

ASSIGN(LLF, 'WORLD.DAT')? RESET(LLF)? 

WHILE NOT EOF(LLF) DO 
BEGIN 

READ(LLF, LL)? 

IF KeyPressed THEN GOTO XIT? 

LONGR:=LL.LONGI * RadianDivlOO? 

LATR :-LL.LATI * RadianDivlOO? 

IF LL.CODE - 'LS* THEN LastPtVis:-FALSE? 

IF (LL.CODE * 'S ') OR (LL.CODE - 'LS•) THEN 
BEGIN 

CASE MapType OF 

IS BEGIN MERCATOR(LONGR, LambdaO, LATR, R, X, Y)? END? 

2: BEGIN EQUICYL(LONGR, LambdaO, LATR, Phil, R, X, Y)? END? 

3: BEGIN SINUSOIDAL(LONGR, LambdaO, LATR, R, X, Y)? END? 

4: BEGIN HAMMER(LONGR, LambdaO, LATR, R, X, Y)? END? 

5: BEGIN ORTHOGRAPHIC(LONGR, LambdaO, LATR, Phil, R, X, Y)? END? 

END? { CASE...) 

IF X > -300 THEN 
BEGIN 

XP:GROUND(X *ASPECT)+XCENTER ? 

IF ABS(LastX-XP) > 100 THEN LastPtVis:-FALSE? 

YP:- YCENTER-ROUND(Y) ? 

PlotPt(LastPtVis)? LastX:-XP? 

END ELSE LastPtVis:-FALSE? 

END? 

END? 

XIT: 

END? { DrawMap. ) 

(*- MAIN PROGRAM -*) 


VAR RESP : CHAR? 

LABEL XIT? 

BEGIN 

MapType:=1? 

WHILE MapType > 0 DO (* MENU *) 

BEGIN 

ClrScr? 


GOTOXY(24,1) 
LowVideo? 
GOTOXY(1,24) 
WRITE('':4 
GOTOXY(1,3)? 
WRITELN(• 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN(' 
WRITELN? 
WRITELN(' 
NormVideo? 


WRITE('C A R T O G')? 


Copyright 1987 by Robert Miller and Francis Reddy')? 

4,'To PLOT: Choose a projection. Enter the Central ')? 

4,'Meridian of the map (180 to -180 degrees, longitudes'); 
4,'west of Greenwich negative). If applicable, enter')? 

4,'the Standard Parallel (90 to -90 degrees, southern')? 

4,'latitudes negative). The file WORLD.DAT must also be')? 
4,'on the logged drive. A tone means the map is done.'); 

4,'Any key ABORTS plot. Hit return to restore MENU.')? 


WRITELN? 

WRITELN? 

WRITE(* ':6,'1. Mercator')? 

WRITELN(* ' :21,'4. Hammer')? 

WRITE(' ':6, '2. Equidistant Cylindrical'); 

WRITELN(' ':6, 1 5. Orthographic')? 

WRITELN(' ' : 6, '3 . Sinusoidal')? 

WRITELN; 

WRITE(' ': 8,'Projection number (1-5) or 0 to quit: *<) ? 

READLN(MapType)? 

If MapType - 0 THEN GOTO XIT? 
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WRITELN; 

WRITE(' 8,'Central Longitude of Map (default =0): '); 

Lambda0:=0; 

READLN(Lambda0); LambdaO:=LambdaO*Radian; 

IF (MapType = 2) OR (MapType = 5) THEN 
BEGIN 

WRITE(' 8,'Central Latitude of Map (default =0): '); 

Phil:=0; READLN(Phil)? 

IF Phil = 90 THEN Phil : = HalfPI 
ELSE 

Phil:=Phil*Radian ? 

END? 

IF MapType >= 4 THEN R:=83 ELSE R:=70; 

WRITE(' 1 :8, 1 Plot grid, continents or both (G/C/B)? ')? 

READLN(RESP)? RESP:=UPCASE(RESP)? 

GRID:-(RESP = 'G') OR (RESP = 'B')? 

HiRes; HiResColor(15)? { Set CGA Graphics Mode ) 

IF GRID THEN CoordinateGrid(FALSE, MapType)? 
CoordinateGrid(TRUE, MapType); 

IF (RESP = *B') OR (RESP - 'C') THEN DrawMap(MapType); 

Beep ? 

XIT: 

IF MapType > 0 THEN 

While NOT KeyPressed DO ? { Wait for key strike ) 

TEXTMODE(BW80); ( Return to Text Mode ) 

ClrScr; 

END? { WHILE MapType > 0...) 

END. 


CPLOT.PAS Accompanies "Mapping the World in Pascal" by Robert Miller and 
Francis Reddy, BYTE, December 1987, page 329 


PROGRAM MapProjections; 

{ Map projection program for Hewlett-Packard 7475 plotter. 
{$V-> 

1.4142135623710? 

3.141592653589793238? 

1.570796326794897? 

4.71238898038469? 

6.283185307179587; 

57.29577951308232088; 


CONST Sqrt2 
PI 

HalfPI = 
ThreePI2= 
TwoPI 
Degree 



Radian 

- 0.01745329251994329577? 

CONST 

XCENTER : REAL =*6.2 
YCENTER : REAL * 5.1 

? ( CGA Graphics constants. ) 


ASPECT 

: REAL = 1 

0 


R 

: REAL - 1 

• 

TYPE 

S80 

- STRING(80]? 


TYPE 

LLREC 

=* RECORD 



CODE 

: ARRAY(0.. 

1] OF CHAR; 


LONGI, 

LATI : INTEGER? 

END? 

VAR 

LL 

: LLREC; 



LLF 

: FILE OF LLREC; 


PLT 

: TEXT[$1000)? 

VAR 

FNAME 

: STRING[64] 

# 

VAR 

LastX, 

LastY, XP, YP : 

REAL? ( Save variables for plotting 


COLOR 

GLB, IPEN 

INTEGER? 


SIZE 

: 

CHAR? 

VAR 

I, J, 

K, MapType, M, XI 

,Y1, X2, Y2, 


SX, SY 

, CENTER : 

INTEGER? 

VAR 

L, LI, 

LONGR, LSTEP, 



B, LATR, BSTEP, X, Y, 



PHI 1, 

LambdaO : 

REAL? 

VAR XX, YY, 

SA, SB : 

REAL? 


) 


continued 
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VAR LastPtVis, GRID : BOOLEAN; 

VAR CH : CHAR; 

PROCEDURE Initialize? 

BEGIN 

WRITE(’ ' : 13, 'Enter map size (A/B): '); READLN(SIZE); 

SIZE:=UPCASE(SIZE);; 

ASSIGN(PLT, 'WORLD.PLT'); REWRITE(PLT); 

WRITELN(PLT, 'IN;')? 

IF SIZE = 'A' THEN WRITELN(PLT,'PS4; IP 100,100,868,868;') 
ELSE WRITELN(PLT, 'PSO; IP 100,100,1124,1124?'); 

WRITELN(PLT, 'SC 0,1,0,1;'); 

WRITELN(PLT, 'VS 4; SP 3;'); 

END; ( Initialize. ) 


PROCEDURE LabelMap(MapType : INTEGER); 

VAR TITLE : STRING[80]? 

VAR XT, YT I REAL; 

BEGIN 

CASE MapType OF 

1: BEGIN TITLEMercator'; END; 

2: BEGIN TITLE:='Equidistant Cylindrical'? END; 

3; BEGIN TITLE:='Miller'; END; 

4; BEGIN TITLE:*'Sinusoidal•? END; 

5: BEGIN TITLE:*'Hammer'? END; 

6: BEGIN TITLE;='Orthographic' ; END; 

7; BEGIN TITLE:='Stereographic'; END; 

END; 


TITLE:=TITLE + » Map Projection'; 

IF SIZE = 'A' THEN XT:*12.38 
ELSE XT:* 14? 

YT:= YCENTER-4.5 ? 

WRITELN(PLT, 'DI 0,1? SR 18,18? PU',XT:7:2, ',', YT:7:2)? 
WRITELN(PLT, 'LB' + TITLE + CHR(3)+'?')? 

XT:*XT -fO.24? 

WRITELN(PLT, 'PU ',XT:7:2, ',', YT:7:2, '? SR 14,14?')? 

WRITELN (PLT, ' LBCentral Meridian • , ROUND(LambdaO*Degree) : 4 , 

' degrees'+CHR(3)+'?')? 

IF (MapType * 2) OR (MapType *6) OR (MapType * 7) THEN 
BEGIN 

XT:*XT +0.24; 

WRITELN(PLT, 'PU ',XT:7:2, ',', YT:7:2, '?')? 

WRITELN(PLT, 'LBCentral Latitude ',ROUND(Phil*Degree):4, 
' degrees'+CHR(3)+'?')? 

END? 


XT:=XT +0.24? 

WRITELN(PLT, 'SR 10,10? PU', XT:7:2 YT:7:2,'?'); 

WRITELN(PLT, 'LBRobert D. Miller, 1986.' +CHR(3)+'?'); 
END; { LabelMap. } 

FUNCTION ArcCos(X: REAL): REAL; 

BEGIN 

IF ABS(X) < 1 THEN ArcCos:- ARCTAN(SQRT(1-SQR(X))/X) 
ELSE IF X * 1 THEN ArcCos:* 0 
ELSE IF X *-l THEN ArcCos:* PI? 

END? { ArcCos. ) 


FUNCTION ArcSin(X: REAL): REAL; 

BEGIN 

IF ABS(X) < 1 THEN ArcSin:* ARCTAN(X/SQRT(1-SQR(X))) 

ELSE IF X * 1 THEN ArcSin:* HalfPI 
ELSE IF X =-l THEN ArcSin:=-Ha1fPI? 

END? ( ArcSin. ) 

FUNCTION ArcTanH(TERM : Real): Real? (* Inverse hyperbolic tangent *) 
VAR A,T : real? 

BEGIN 

T:=ABS(TERM)? 

IF T < 1 THEN 
BEGIN 

A :* 0.5 * LN( (1 +T)/(1 -T)) ? 

IF TERM < 0 THEN ArcTanH :- -A ELSE ArcTanH :=A? 

END? 

END? { ArcTanH. ) 

(* 

Map Projection Library 

by Robert Miller and Francis Reddy, 20 October 1986. 

The following routines are based on equations found 
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in the U.S. Geological Survey's Bulletin 1532, 

"Map Projections Used by the U.S. Geological Survey" 
by John P. Snyder and "Introduction to Map Projections" 
by Porter McDonnell, Jr. 

*) 

FUNCTION Meridian (Lambda, LambdaO: REAL)-.REAL? 

{ Returns difference between current longitude and map center. ) 

VAR DelLam : REAL? 

BEGIN 

DelLam : = Lambda - LambdaO? 

IF DelLam < -PI THEN DelLam : = DelLam + TwoPi 
ELSE 

IF DelLam > PI THEN DelLam : = DelLam - TwoPi? 

Meridian:=DelLam ? 

END? { Meridian. ) 

PROCEDURE Mercator(Lambda, LambdaO, Phi, R : REAL? VAR X, Y : REAL)? 

( For R * Is -Pi <- X <- Pi, -Pi/2 <= Y <= Pi/2. ) 

CONST MaxLat : REAL - 1.397? (-80 degrees. ) 

{ REAL * 1.483? -85 degrees. ) 

BEGIN 

IF ABS(Phi) < MaxLat THEN 
BEGIN 

Lambda :- Meridian(Lambda, LambdaO)? 

X :— R * Lambda? 

Y :— R * AtcTanH(SIN(Phi))? 

END 

ELSE X := -32767,- 
END? { Mercator. ) 

PROCEDURE EquiCyl(Lambda, LambdaO, Phi, Phil, R : REAL? VAR X, Y : REAL)? 

( For R = Is -Pi <« X <- Pi, -Pi/2 <- Y <= Pi/2. ) 

BEGIN 

Lambda :- Meridian(Lambda, LambdaO)? 

X R * Lambda * COS(Phil)? 

Y := R * Phi? 

END? ( Equicyl. ) 

PROCEDURE Miller(Lambda, LambdaO, Phi, R : REAL? VAR X, Y : REAL)? 

( For R - 1: -Pi <= X <- Pi, -Pi/2 <= Y <- Pi/2. ) 

BEGIN 

Lambda Meridian(Lambda, LambdaO)? 

X :» R * Lambda? 

Y :- R * ArcTanH(SIN(0.8 * Phi)) * 1.25,- 
END? ( Miller. ) 

PROCEDURE Sinusoidal(Lambda, LambdaO, Phi, R : REAL? VAR X, Y : REAL)? 

( For R - Is -Pi <= X <= Pi and -Pi/2 <= Y <* Pi/2. ) 

BEGIN 

Lambda Meridian(Lambda, LambdaO)? 

X : - R * Cos(Phi) * Lambda ? 

Y R * Phi? 

END? { Sinusoidal. ) 

PROCEDURE Hammer(Lambda, LambdaO, Phi, R : REAL? VAR X, Y : REAL)? 

( For R = Is -2«2 <= X <=2«2 and -«2 <= Y <- «2. ) 

VAR K, CosPhi, HalfLambda : REAL? 

BEGIN 

HalfLambda 0.5*Meridian(Lambda, LambdaO)? 

CosPhi:-COS(Phi)? 

K :* R * SQRT2 / SQRT(1 tCosPhi * COS(HalfLambda))? 

X :» 2 * K * CosPhi * (SIN(HalfLambda))? 

Y : =* K * SIN(Phi) ? 

END? ( Hammer. ) 

PROCEDURE Orthographic(Lambda, LambdaO, Phi, Phil, R: REAL? VAR X, Y : REAL)? 
( For unit radius R of generating globe, R = 1, -2 <« X,Y <« 2. ) 

VAR CosC, CosL, SinPhil, CosPhil, SinPhi, CosPhi, R2 : Real? 

BEGIN 

Lambda :=Meridian(Lambda, LambdaO)? R2:=R+R? 

CosPhil:-COS(Phil)? SinPhil:-SIN(Phil)? 

CosPhi :=COS(Phi)? SinPhi:- SIN(Phi)? 

CosL :—COS(Lambda)*CosPhi? 

CosC :-SinPhil * SinPhi + CosPhil * COSL? 

IF CosC >- 0 THEN 
BEGIN 

X :=R2 * CosPhi * SIN(Lambda)? 

Y :-R2 * (CosPhil * SinPhi - SinPhil * COSL)? 

END ELSE X:—32767,- 

END? ( Orthographic. ) 
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PROCEDURE Stereographic(Lambda, LambdaO, Phi, Phil, R : REAL; VAR X, 
{ For R = 1, -2 <= X,Y <= 2. } 

VAR K, CosC, CosL, CosPhi, SinPhi, SinPhil, CosPhil : Real? 

BEGIN 

Lambda :=Meridian(Lambda, LambdaO); 

IF (Lambda <> LambdaO + TwoPi) OR (Lambda <> LambdaO-TwoPi) THEN 
BEGIN 

SinPhi:= SIN(Phi); CosPhi:= COS(Phi)? 

SinPhil:=SIN(Phil)? CosPhil:=COS(Phil); 

CosL:=COS(Lambda) * CosPhi? 

CosC :=SinPhil * SinPhi + CosPhil * COSL; 

IF CosC >= 0 THEN 
BEGIN 

K :» R * 2 / (1 + CosC)? 

X := K * CosPhi * SIN(Lambda); 

Y := K * (CosPhil * SinPhi - SinPhil * COSL) ? 

END 

ELSE X:=-32767? 

END? 

END; { Stereographic. } 

PROCEDURE PlotPt(VAR LastPtVis: BOOLEAN); 

{ Draws a line from the last point to the current (XP,YP) if it is 
LABEL XIT; 

BEGIN 

IF LastPtVis THEN WRITELN(PLT, 'PD',XP;7:3, YP;7:3, , ; , ) 

ELSE WRITELN(PLT, 'PU',XP:7:3, »,», YP;7;3, , ; , ); 

LastX:=XP; LastY:=YP? LastPtVis:=TRUE; 

XIT: 

END; ( PlotPt. ) 

PROCEDURE CoordinateGrid(OUTLINE: BOOLEAN; MapType: INTEGER); 

VAR Longitude, Latitude, MaxLat, Longlncr, Latlncr : INTEGER; 

VAR LL, PP, A, RA, R2 : REAL? 


VAR X, Y, XN, YN, 

SINDT, COSDT 

: REAL? 



BEGIN 





CASE MapType 

OF 




1: BEGIN 

MaxLat:=75? 

Longlncr:=360? 

Latlncr:=160? 

END; 

2: BEGIN 

MaxLat:=90 ? 

Longlncr:=360; 

Latlncr:=180; 

END; 

3: BEGIN 

MaxLat:=90? 

Longlncr:=360? 

Latlncr:=5; 

END? 

4..5: BEGIN 

MaxLat:=75? 

Longlncr:=5? 

Latlncr:=5; 

END; 

END; ( CASE. 






LL:=0; PP:=Phil? 

IF OUTLINE THEN 

BEGIN IF MapType > 1 THEN MaxLat:=90 

ELSE MaxLat:=80? 

IF MapType >= 5 THEN PP:=0? 

END? 

Latitude:=MaxLat ? 

WHILE Latitude >= -MaxLat DO { Draw parallels ) 

BEGIN 

LATR:=Latitude*Radian? 

LastPtVis:=FALSE? 

Longitude:=-180? 

WHILE Longitude <= 180 DO 
BEGIN 

LONGR:=Longitude*Radian? 


CASE MapType OF 

1: BEGIN MERCATOR(LONGR, LL, LATR, R, X, Y)? END? 
2: BEGIN EQUICYL(LONGR, LL, LATR, PP, R, X, Y)? END? 
3: BEGIN MILLER(LONGR, LL, LATR, R, X, Y)? END; 
4: BEGIN SINUSOIDAL(LONGR, LL, LATR, R, X, Y)? END; 
5: BEGIN HAMMER(LONGR, LL, LATR, R, X, Y)? END; 


6: BEGIN ORTHOGRAPHIC( LONGR, LL, LATR, PP, R, X, Y)? END 
7: BEGIN STEREOGRAPHIC(LONGR, LL, LATR, PP, R, X, Y); END 
END; { CASE...) 

IF X > -300 THEN 
BEGIN 

XP:=X+XCENTER; 

YP:=Y+YCENTER; 

PlotPt(LastPtVis); 

END ELSE LastPtVis:=FALSE; 

Longitude:=Longitude+LongIncr; 

END; 

IF OUTLINE THEN Latitude:-Latitude-2*MaxLat 

ELSE Latitude:-Latitude-15? ( Latitude:-Latitude-10? ) 

END; 


Y : REAL) ? 


visible. ) 
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IF OUTLINE THEN LL:=0 ELSE LL:=LambdaO? 

Longitude:=-180? { Draw meridians ) 

IF OUTLINE AND (MapType > 5) THEN Longitude:=-90? 

IF MapType >= 4 THEN MaxLat:=90? 

WHILE Longitude <= 180 DO 
BEGIN 

LONGR:=Longitude*Radian; 

LastPtVis:=FALSE ? 

Latitude:=MaxLat; 

WHILE Latitude >= -MaxLat DO 
BEGIN 

LATR:=Latitude*Radian? 


CASE MapType OF 

1: BEGIN MERCATOR(LONGR, LL, LATR, R, X, Y)? END; 
2: BEGIN EQUICYL(LONGR, LL, LATR, PP, R, X, Y)? END? 
3: BEGIN MILLER(LONGR, LL, LATR, R, X, Y)? END; 
4: BEGIN SINUSOIDAL(LONGR, LL, LATR, R, X, Y)? END; 
5: BEGIN HAMMER(LONGR, LL, LATR, R, X, Y); END; 


6: BEGIN ORTHOGRAPHIC( LONGR, LL, LATR, PP, R, X, Y); END? 
7: BEGIN STEREOGRAPHIC(LONGR, LL, LATR, PP, R, X, Y)? END? 
END? { CASE...) 

IF X > -300 THEN 
BEGIN 

XP:=X+XCENTER ? 

YP:=Y+YCENTER? 

PlotPt(LastPtVis); 

END ELSE LastPtVis:-FALSE? 

Latitude:=Latitude-LatIncr ? 

END; 

IF OUTLINE THEN 

IF MapType <= 5 THEN Longitude:=Longitude+360 
ELSE 

Longitude:=Longitude+180 
ELSE Longitude:=Longitude+15? 

END? 

IF NOT OUTLINE AND (MapType = 6) THEN ( Draw circular outline. ) 
BEGIN 

A:=0 ? LastPtVis:=FALSE ? 

R2:=R+R? RA:=R2*Aspect? 

SINDT:=0.05996400648? 

COSDT:=0.99820053993? 

X:=l? Y:=0; 

XP:-ROUND(XCENTER+RA)? YP:=ROUND(YCENTER)? 

PlotPt(LastPtVis)? 

WHILE A <*= 6.28318 DO 
BEGIN 

XN:= X * COS DT - Y*SINDT; 

YN:= X*SINDT + Y*COSDT; 

X:=XN ? Y:=YN? 

XPi-XCENTER + ROUND(X*RA)? YP:“YCENTER + ROUND(Y*R2)? 
PlotPt(LastPtVis); 

A:=A+0.06; 

END? 

END? 

END? ( CoordinateGrid. ) 

PROCEDURE DrawMap(MapType: INTEGER)? 

VAR Latitude, Longitude : REAL? 

VAR LastX : REAL; 

BEGIN 

LastPtVis:-FALSE ? LastX:-0 ? LastY:=0 ? 

IF Fname = •• THEN 
ASSIGN(LLF, * EARTH.LAT•) 

ELSE ASSIGN(LLF, Fname); 

RESET(LLF)? 

WHILE NOT EOF(LLF) DO 
BEGIN 

READ(LLF, LL)? 

LONGR:-LL.LONGI* 1.745329251994329577E-4? 

LATR :-LL.LATI * 1.745329251994329577E-4? 


continued 
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IF LL.CODE = * LS' THEN LastPtVis:=FALSE; 

IF (LL.CODE — ' S *) OR (LL.CODE - 'LS') THEN 
BEGIN 


CASE MapType OF 

1: BEGIN MERCATOR(LONGR, Lambda0, LATR, R, X 
2: BEGIN EQUICYL(LONGR, LambdaO, LATR, Phil, 
3: BEGIN MILLER(LONGR, LambdaO, LATR, R, X, 
4: BEGIN SINUSOIDAL(LONGR, LambdaO, LATR, R, 
5: BEGIN HAMMER(LONGR, LambdaO, LATR, R, X, 
6: BEGIN ORTHOGRAPHIC(LONGR, LambdaO, LATR, 
7: BEGIN STEREOGRAPHIC(LONGR, LambdaO, LATR, 
END; { CASE...} 


, Y)? 

END 

R, X, Y); 

END 

Y) ; 

END 

X, Y); 

END 

Y) ; 

END 

Phil, R, X, 

r Y) 


Phil, R, X, Y); 


END; 

END; 


IF X > -300 THEN 
BEGIN 

XP:=X+XCENTER; 

IF ABS(LastX-XP) >0.4 THEN LastPtVis:=FALSE; 
YP;=Y+YCENTER; 

PlotPt(LastPtVis); LastX:=XP; 

END ELSE LastPtVis:=FALSE; 

END; 

END; 

END; ( DrawMap. ) 

(*- MAIN PROGRAM -*) 

VAR RESP : CHAR; 

LABEL XIT; 

BEGIN 

LastPtVis:=FALSE; LastX:=0; LastY:=0; IPEN:=-1; 

MapType:«1; 

Fname:='•? 

Fname:-»WORLD4.DAT'; 


(* MENU *) 

WHILE MapType > 0 DO 
BEGIN 

ClrScr; 


GOTOXY(30,1) 
GOTOXY(32,3) 
WRITELN; 
WRITELN(' ': 

WRITELN(» •: 

WRITELN(' ': 

WRITELN(• ': 

WRITELN(• ': 

WRITELN(• •: 
WRITELN(' ': 


; WRITE('GLOBE MAP PROJECTIONS') 
; WRITELN('SELECT PARAMETERS'); 

10,'1. Mercator')? 

10,'2. Equidistant Cylindrical'); 
10,'3. Miller Cylindrical'); 

10,'4. Sinusoidal'); 

10,'5. Hammer-Aitoff'); 

10,'6. Orthographic'); 

10,'7. Stereographic')? 


WRITELN; 

WRITE(' ':13,'Projection number (1-7) or 0 to quit: '); 
READLN(MapType); 


If 

MapType = 0 THEN 

GOTO 

CASE MapType OF 


1: 

BEGIN 

R:-1.82; 

END; 

2: 

BEGIN 

R:-l.82; 

END; 

3: 

BEGIN 

R:-1.82; 

END; 

4: 

BEGIN 

R:-1.82; 

END; 

5: 

BEGIN 

R:=2.04; 

END; 

6: 

BEGIN 

R:=2.18; 

END; 

7: 

BEGIN 

R:-2.18; 

END; 


END; 


WRITELN; 

WRITE(' ':13,'Central Longitude of Map (degrees, default = 0): '); 
LambdaO:=0; 

READLN(LambdaO); LambdaO:«LambdaO*Radian; 


IF (MapType * 2) OR (MapType - 6) OR (MapType - 7) THEN 
BEGIN 

WRITE(' ':13,'Central Latitude of Map (degrees, -90 - 90): '); 
Phil:®0; READLN(Phil)? Phil:«Phil*Radian; 

END; 

WRITE(' ':13, ’Plot grid, continents or both (G/C/B)? '); 

READLN(RESP); RESP:-UPCASE(RESP); 

GRID:=(RESP »'G') OR (RESP ■ 'B')? 

Initialize; 


IF GRID THEN 
BEGIN 

WRITELN(PLT,'SP 2;'); 
CoordinateGrid(FALSE, MapType); 

END; 
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WRITELN(PLT,'SP 3;*)? 

CoordinateGrid(TRUE, MapType); 

WRITELN(PLT, 'SP 1’)? 

IF (RESP = 'B') OR (RESP = 'C') THEN DrawMap(MapType)? 

( LabelMap(MapType)? ) 

WRITELN(PLT, ' PU 0,0; SP 0?')? 

CLOSE(PLT); 

XIT; 

END? ( WHILE MapType > 0...) 

END. 


READ.ME Accompanies "Mapping the World in Pascal" by Robert Miller and Francis 
Reddy, BYTE, December 1987, page 329 


To use Cartog.pas with an EGA or Hercules board, you will need to use the follow 


EGA Constants: 


Hercules Constants: 


CONST XCENTER - 320? 
YCENTER = 174? 
ASPECT = 1.37? 
R = 70? 


CONST XCENTER = 360? 
YCENTER = 174,- 
ASPECT = 1.5? 
R = 70? 


Also you will need a software driver for these boards. For example, if you want 
The following three lines go at the top of the program, right after the line 
"Program Cartog?" 


($1 Typedef.sys) 

($1 graphix.sys) 

{$1 Kernel.sys) 

replace "HiRes? HiResColor(15)?" with the following four lines: 


Initgraphic? 

defineWorld(l,0,348,719,0)? 
selectWorld(l)? 
selectWindow(l)? 


Finally replace TEXTMODE(BW80); with Leavegraphic; 


Setup for the plotter: 

Our plots were made with a Hewlett-Packard 7475. A separate 
version of CARTOG was made to output to the plotter. The 
constants that we used were: 

CONST XCENTER » 6.2? ( Page center for B size plot ) 

YCENTER « 5.1? 

ASPECT =1? ( Scale factors are the same in both axes ) 

R - 1? ( Unit radius, scale in the plotting routine ) 

We also added a plotter initialization procedure: 

PROCEDURE Initialize? 

( PLT is a text file containing the plotter commands. 

At the termination of this program, the file is copied to the 
plotter 

) 

BEGIN 

WRITE(* # : 13, 'Enter map size (A/B): ')? READLN(SIZE)? 

SIZE:«UPCASE(SIZE)? 

ASSIGN(PLT, 'WORLD.PLT')? REWRITE(PLT)? 

WRITELN(PLT, 'IN;')? ( Command to initialize plotter ) 

( Set paper size and scaling points, so 
plotter effectively works in inches 
for B size plots and a little less for 
A size plots ) 

IF SIZE =* 'A' THEN 

WRITELN(PLT,'PS4? IP 100,100,868,868?') 


continual 
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ELSE 

WRITELN(PLT, 'PSO? IP 100,100,1124,1124;')? 

WRITELN(PLT, 'SC 0,1,0,1?')? 

{ Set pen speed (slow) and select pen 3 ) 
WRITELN(PLT, 'VS 4; SP 3?')? 

END; ( Initialize. ) 

Finally, we substituted the following for PROCEDURE PlotPt: 
PROCEDURE PlotPt(VAR LastPtVis: BOOLEAN); 

{ Draws a line from the last point to the current (XP,YP) if it 
is visible. ) 

BEGIN 

IF LastPtVis THEN ( Pen down, go to XP, YP ) 

WRITELN(PLT, 'PD', XP:7:3, ',', YP:7:3,'?') 

ELSE { Pen up, go to XP, YP ) 

WRITELN(PLT, 'PU' , XP:7:3, ',', YP:7:3,';')? 

LastX:*; LastY:=YP? 

LastPtVis;=TRUE ? 

END; ( PlotPt. ) 


3-D.PAS Accompanies "Mimicking Mountains," by Tom Jeffery, 
BYTE, December 1987, page 337 


program THREEDEE; 

(Wireframe or shaded representation of a fractal surface) 
uses 

quickdrawl, quickdraw2? 
const 

size = 64; (Max array index) 
type 

surface = array[0..size, 0..size) of longint? 
var 

srf : surface; 
ans : string(10); 
srfile : file of longint? 
col, row, range : longint? 

Pt, pt2 : point? 
ret : rect; 

solar : array[1..3] of real; 
az, alt : real? 

Grayscale : array(0..8] of pattern; 

procedure SetUpDrawing? 
var 

R ; Rect ? 
begin 
HideAll? 

SetRect(R, 0, 38, 511, 341); 

SetDrawingRect(R)? 

ShowDrawing 
end ? 

function rangefind ; longint; 

(Finds the difference between the highest) 

(and lowest points on the surface) 
var 

min, max, r, c : longint? 
begin 

min :» maxlongint? 
max := -maxlongint? 
for r :» 0 to size do 
for c :■ 0 to size do 
begin 

if srf[r, c] < min then 
min := srf(r, c)? 
if srf[r, c) > max then 
max ;= srf[r, c]; 
end? 

rangefind :« max - min? 
end? 

function proj (r, c : longint) : point; 

(Converts row/col/height coord into point on screen) 
var 

z : longint? 
pt : point? 
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begin 

z := (100 * srf(r, c]) div range; (Height) 
pt.h ;= (4 * c) + 3 * r + 10? (Horiz screen coord) 
pt.v 70 - (z - 2 * r)? (Vert screen coord) 

proj := pt? 
end? 

procedure shade (row, col : longint)? 

(Selects a gray shade for a patch) 
var 

i : longint? 

dim, ill, normlen : real; 
normal : array[1..3] of real? 
begin 

dim := 100 / range; 

(Cross product of two vectors) 

normal[1] := -dim * (srf[row, col] - srffrow + 1, col])? 
normal[2] := -dim * (srf[row, col] - srf(row, col + 1])? 
normal[3] :=* 1? 

normlen := sqrt(sqr(normal[1]) + sqr(normal(2]) + sqr(normal[3]))?(Vector 
length) 

for i := 1 to 3 do 

normal[i] :« normal[i] / normlen? (Normalize vector) 
ill := 0? 

for i := 1 to 3 do 

ill := ill + solar[i] * normalfi]? (Dot product of normal and solar) 
if ill < 0 then 
penpat(grayscale(O)) 
else 

penpat(grayscale[round(ill * 7.9)])? (Set gray level) 
end; 

procedure shadeframe? 

(Shades surface) 
var 

r, c : longint? 
start, curr : point? 
patch : polyhandle; 
begin 

for r := 0 to size - 1 do 
for c :— 0 to size - 1 do 
begin 

patch := openpoly? (Open polygon for patch) 

(Define patch) 

start := proj(r, c); 
moveto(start.h, start.v)? 
curr :» proj(r, c + 1)? 
lineto(curr.h, curr.v); 
curr :=* proj(r + 1, c + 1) ? 
lineto(curr.h, curr.v)? 
curr := proj(r + 1, c)? 
lineto(curr.h, curr.v); 
lineto(start.h, start.v)? 
closepoly? 

shade(r, c)? (Get shade of patch) 
paintpoly(patch); (Color patch) 
killpoly(patch)? 
end? 
end? 

procedure wireframe? 

(Draws wireframe of surface) 
var 

r, c : longint? 
start, curr : point? 
patch : polyhandle? 
begin 

setupdrawing? 
for r := 0 to size - 1 do 
for c :■ 0 to size - 1 do 
begin 

patch openpoly? (Open polygon for patch) 

(Define patch) 

start proj(r, c); 

moveto(start.h, start.v)? 
curr proj(r, c + 1)? 
lineto(curr.h, curr.v)? 
curr :« proj(r +1, c + 1)? 
lineto(curr.h, curr.v)? 
curr proj(r + 1, c) ? 
lineto(curr.h, curr.v)? 
lineto(start.h, start.v)? 
closepoly; 


continued 
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pnnpat(white); 

paintpoly(patch); (Cover up patches behind) 
ponpat(black); 

liamcpoly(patch); (Outline patch) 
k i 11poly(patch); 
end; 

n.ivedrawing(• ramdisk:surf ') ; (Save drawing to disk) 
ond; 


procedure shaded; 

(Gets solar vector, and shades surface) 
begin 

write('Solar altitude?')? 
readln(alt); 

alt :=* alt * 3.14159 / 180; 
write('Solar azimuth?'); 
readln(az); 

az := az * 3.14159 / 180; 

(Convert az/alt to three component unit vector) 
solar[3] z- sin(alt); 
solar[2) := sin(az) * cos(alt); 
solarfl) := cos(az) * cos(alt); 
setupdrawing; 

shadeframe; (Shade surface) 
savedrawing('surf'); (Save drawing to disk) 
end; 


begin 

(Define array of patterns 
grayscale[8] := white; 
grayscale[0] := black; 
stuffhex(@grayscale[7], 
stuf f hex (@grayscale[6], 
stuffhex(@grayscale(5), 
stuf fhex(@grayscale[4], 
stuf fhex(@grayscale[3], 
stuffhex(@grayscale [2], 
stuffhex(@grayscale(1], 


in order of darkness) 


'8800220088002200'); 
'AA00AA00AA00AA00'); 
•AA11AA44AA11AA44'); 
'AA55AA55AA55AA55'); 
'DB55EE55BB55EE55•); 
'FF55FF55FF55FF55'); 
'FF77FFDDFF77FFDD'); 


open(srfile, oldfileName('Surface File')); 
for row !■ o to size do 
for col := 0 to size do 
read(srfile, srf[row # col]); 
close(srfile); 
range rangefind; 
repeat 
showtext; 

write('(w)ire, (s)haded, or (q)uit?'); 
readln(ans); 
if ans - *w' then 
wireframe 

else if ans = 's' then 
shaded; 

until ans = 'q'; 
end. 


TEXTURE.PAS Accompanies "Mimicking Mountains," by Tom Jeffery, 
BYTE, December 1987, page 337 


program textures; 
const 

size =* 64; 
var 

srf : array[0..size, 0..size] of longint; 

ans : string[30]; 

srfile : file of longint; 

col, row ; longint; 

procedure SetUpDrawing; 
var 

R : Rect; 
begin 
HideAll; 

SetRect(R, 0, 38, 511, 341); 
SetDrawingRect(R); 

ShowDrawing 

end; 
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procedure paintpt (row, col : longint); 
var 

pt, pt2 : point; 
ret : rect; 
begin 

pt. v : * row ; 
pt.h := col; 
pt2.v := row +1? 
pt2.h := col +1? 
rct.topleft := pt; 
rct.botright :« pt2; 
paintrect(ret); 
end; 

procedure CoastDisp; 

(Displays coastline) 
var 

col, row, int : longint; 
begin 

for row := 0 to size do 
for col 0 to size do 
begin 

if srf[row, col) > 0 then 
penpat(black) 
else 

penpat(white); 
paintpt(row, col); 
end; 
end; 

procedure StripeDisp; 

(Displays stripes for heights defined by int) 
var 

col, row, int : longint; 
begin 

write('Interval? 1 ) ; 
readln(int); 
if int > 0 then 
begin 

for row :■ 0 to size do 
for col :*= 0 to size do 
begin 

if odd(srf[row, col) div int) then 
penpat(black) 
else 

penpat(white); 
paintpt(row, col); 
end; 
end; 
end; 

procedure TopoDisp; 

(Displays contours separated by int) 
var 

col, row, int : longint; 
begin 

write('Interval?'); 
readln(int); 
if int > 0 then 
begin 

for row :» 0 to size - 1 do 
for col :« 0 to size - 1 do 
begin 

if ((srf[row, col] div int) = (srf[row, col + 1) div int)) and 
((srf(row, col) div int) = (srf[row + 1, col) div int)) then 
penpat(white) 
else 

penpat(black); 
paintpt(row, col); 
end; 
end; 
end; 

procedure GrainDisp; 

(Displays wood grain, grain spacing: int) 
var 

col, row, int, res, sp, drk, gr, It : longint; 
begin 

write('Interval?'); 
readln(int); 
if int > 0 then 
begin 

sp :* int div 7; 
drk sp * 2; 


continued 
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It I M|« • 4 * 

|H| | MM I • II In * I /n do 
I mi ini i ii lii hI /.a do 

lh 

.. inf (row, col] mod int; 

i i • ••»» tip then 
I•• • 11 |t (black) 

•» I mi If res < drk then 
ponpat(dkgray) 
else if res < gr then 
penpat(gray) 
else if res < It then 
penpat(ltgray) 
else 

penpat(white); 
paintpt(row, col); 
end; 
end; 
end; 

begin 

open(srfile, oldfileName(‘Surface File*)); 
for row :■ 0 to size do 
for col := 0 to size do 
read(srfile, srf(row, col]); 
close(srfile); 
setorigin(-10, -10); 

write( * 1 (c)oastline, (s)tripe, (t)opo, (g)rain, or (q)uit?‘); 

readln(ans); 

repeat 

if ans(l) = »c‘ then 
coastdisp 

else if ans[l] = ‘s* then 
stripedisp 

else if ans[l] * ‘t‘ then 
topodisp 

else if ans[l] = ‘g’ then 
graindisp; 
write(‘Save?') ; 
readln(ans); 
if ans[l] = 'y‘ then 
begin 

write(* Filename?'); 
readln(ans); 
savedrawing(ans); 
end; 

write('(c)oastline, (s)tripe, (t)opo, (g)rain, or (q)uit?‘); 
readln(ans); 
until ans[l] =» *q‘; 
end. 


FRAKFFC.PAS Accompanies “Mimicking Mountains,” by Tom Jeffery, 
BYTE, December 1987, page 337 


program fractal_ffc; 
const 

size - 64; (Maximum index of array) 
var 

row, col, n, step, st : longint; 

srf : array(0..size, 0..size) of longint; (The surface file) 

ans ; string[10); 

srfile s file of longint; 

H : real; (Roughness factor) 
stepfactor : real; 

function gauss : real; 

(Returns a gaussian variable with mean - 0, variance ® 1) 
(Polar method due to Knuth, vol. 2, pp. 104, 113 ) 

(but found in “Smalltalk-80, Language and Implementation”,) 
(Goldberg and Robinson, p. 437.) 
var 

i : integer; 
sum, vl, v2, s : real; 
begin 
sum :- 0; 
repeat 

vl :■ (random / maxint); 
v2 :« (random / maxint); 
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s := sqr(vl) + sqr(v2)? 
until s < 1? 

s :*= sqrt(-2 * ln(s) / s) * vl; 
gauss := s; 
end; 

procedure hordetail (row : longint)? 

(Calculates new points for one row) 
var 

disp, i, col : longint? 
begin 
col :** 0? 

while col < size do 
begin 

disp := Round(100 * (gauss * stepfactor)); (Random displacement) 
srf[row, col + step) := (srf[row, col] + srf[row, col + 2 * step]) div 2; 
(Midpoint) 

srf(row, col + step] := srf[row, col + step] + disp?(New point) 
col :*= col + 2 * step? 
end? 
end; 

procedure verdetail (col : longint)? 

(Calculates new points for one column) 
var 

disp, i, row : longint? 
begin 
row := 0; 

while row < size do 
begin 

disp Round(100 * (gauss * stepfactor))? (Random displacement) 
srf(row + step, col] (srf(row, col] + srf(row + 2 * step, col]) div 2; 
(Midpoint) 

srf(row + step, col] := srf(row + step, col] + disp? (New point) 
row i- row + 2 * step? 
end? 
end? 

procedure centdetail (row : longint); 

(Calculates new points for centers of all cells in a row) 
var 

disp, i, col : longint? 
begin 

col := step? 
while col < size do 
begin 

disp := Round(100 * (gauss * stepfactor))? (Random displacement) 
srf(row, col) :« (srf(row, col - step] + srf(row, col + step) + srf(row - 
step, col] + srf[row + step, col]) div 4? (Center Point) 
srf[row, col] := srf[row, col) + disp? (New point) 
col :* col + 2 * step; 
end; 
end? 

procedure detail; 

(Calculates new points at current step size) 
var 

i, row, col : longint? 
begin 
row 0; 
col :■ 0 ? 

while row <* size do 
begin 

hordetail(row)? 
row :» row + 2 * step? 
end; 

while col <~ size do 
begin 

verdetail(col); 
col col + 2 * step; 

end? 

row step? 

while row <= size - step do 

begin 

centdetail(row)? 
row row + 2 * step; 

end; 
end? 


procedure newsurface; 
var 

row, col : longint; 
begin 

step :« size? 


continued 
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Hi H|.f .«> I I exp (2 * H * ln(step)); 

■ « i ill Round (100 * (gauss * stepf actor)) ? 

. (/.«) Round (100 * (gauss * stepf actor)) ? 

oj Round (100 * (gauss * stepf actor)) ? 
mi f I iI/.m, nize] := Round(100 * (gauss * stepfactor) ) ? 
i •« | ion I 

ntop step div 2; (Go to smaller scale) 
w i 1 to (* step *■ ') ; 
wi 1 toln(step) ; 

ritupf actor := exp(2 * H * ln(step)); (Factor proportional to step size) 
detail; (Calculate all new points at current step size) 
until step = 1? 
end; 

begin 

showtext; 

write('H = ?');(Set roughness) 
readln(H)? 

open(srfile, NewfileName(’Surface File')); 
st tickcount; 
randseed := st; (Randomize) 
newsurface; (Calculate surface) 
for row := 0 to size do 
for col := 0 to size do 

write(srfile, srffrow, col]); (Store surface in file) 
close(srfile); 

st := (tickcount - st) div 3600; 
write(st) ; 

writeln(* minutes'); 
end. 


MAP.PAS Accompanies "Mimicking Mountains,” by Tom Jeffery, BYTE, December 
1987, page 337 


program Map; 
const 

size = 64; 
cell * 2; 
type 

twohts * array[1..2] of longint; 
levarray - array(0..8] of longint; 
var 

srf : array[0..size, 0..size] of longint; 
Srfilename, ans : string[30]; 
srfile : file of longint; 
col, row, cont : longint; 

Pt, pt2 : point; 
ret : rect; 

Grayscale : array[0..8] of pattern; 

procedure SetUpDrawing; 
var 

R ; Rect; 
begin 
HideAll; 

SetRect(R, 0, 38, 511, 341); 

SetDrawingRect(R); 

ShowDrawing; 
setorigin(-30, -30); 
moveto(45, -5); 
drawstring('MAP'); 
end; 

function minmax ; twohts; 

(Min surface height is minmax(l), max is minmax[2]} 
var 

mm : twohts; 
r, c : longint; 
begin 

mm(l] := maxlongint; 
mm(2] :« -maxlongint; 
for r :* 0 to size do 
for c :■ 0 to size do 
begin 

if srf[r, c] < mm[l) then 
mm[l) srf(r, c]; 
if srf[r, c] > mm(2] then 
mm[2] srf(r, c]; 
end; 

minmax mm; 
end; 
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procedure paintpt (row, col : longint); 
{Fill a cell x cell square with penpat) 
begin 

pt.v := row * cell; 
pt.h := col * cell? 
pt2.v := (row + 1) * cell? 
pt2.h (col + 1) * cell? 
rct.topleft pt; 
rct.botright pt2? 
paintrect(ret)? 
end? 


procedure mapDisp; 
var 

i, sum, row, col, levl, range : longint? 
lev : array[0..8] of longint? 
mm : twohts? 
begin 

mm := minmax? 

range mm[2] - mm[l); 

sum : — mm(l)? (Min height of surface) 

levl :** (range div 9) +1? (Eight height zones, spearated by levl) 
for i :« 0 to 8 do ' 

begin 

sum :*= sum + levl? 

lev[i] := sum? (Nine height zones, lev[l]-lev[8]) 
end; 

moveto(140, -5); 

{Legend) 

for i :*= 0 to 8 do 
begin 

penpat(grayscale(i])? 
pt.h :« 140? 
pt.v i * 15; 
pt2.h := 150? 
pt2.v := i * 15 + 10? 
rct.topleft := pt; 
rct.botright :=* pt2; 
paintrect(ret)? 
penpat(black)? 
framerect(ret); 
moveto(153, i * 15 + 10); 
writedraw(lev(i])? 
end; 

(Map) 

for row := o to size do 
for col :=* o to size do 
begin \ 

i :» 0? 

while (srf[row, col) > lev(i)) do 
i i + 1? (Compare height to zones) 
penpat(grayscale(i))? (Choose gray shade corresponding to zone) 
paintpt(row, col); 
end? 
end? 


'8800220088002200' 
'AA00AA00AA00AA00' 
'AA11AA44AA11AA44' 
'AA55AA55AA55AA55' 
'BB55EE55BB55EE55' 
'FF55FF55FF55FF55' 
'FF77FFDDFF77FFDD' 


begin 

setupdrawing; 

(Set up array of patterns) 
grayscale^] white? 

grayscale(0) black? 

stuffhex(§grayscale[7], 
stuf fhex(@grayscale(6), 
stuf fhex(@grayscale[5], 
stuffhex(©grayscale[4], 
stuffhex(©grayscale[3), 
stuffhex(©grayscale[2), 
stuffhex(©grayscale[1), 
repeat 

srfilename oldfileName('Surface File') 
open(srfile, srfilename)? 
for row :■ 0 to size do 
for col :« 0 to size do 
read(srfile, srf(row, col))? 
close(srfile)? 
mapdisp? (Draw Map) 
showtext ? 

write('Save map?')? 
readln(ans); 
if ans(l) - 'y' then 
begin 

write('File name?')? 
readln(ans)? 


) 

) 

) 

) 

) 

) 

) 


continued 
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IKAKVOSS.PAS Accompanies "Mimicking Mountains," by Tom Jeffery, 
BYTE, December 1987, page 337 


program fractalVoss? 
const 

size = 64; {Maximum index of array) 
var 

row, col, n, step, st : longint; 

srf : array[0..size, 0..size] of longint; {The surface file) 

ans : string[10); 

srfile : file of longint; 

H : real; {Roughness factor) 
stepfactor : real; 

function gauss ; real; 

{Returns a gaussian variable with mean = 0, variance = 1) 

{Polar method due to Knuth, vol. 2, pp. 104, 113 ) 

{but found in "Smalltalk-80, Language and Implementation",) 

{Goldberg and Robinson, p. 437.) 
var 

i ; integer? 
sum, vl, v2, s : real; 
begin 
sum :« 0; 
repeat 

vl :* (random / maxint)? 
v2 :« (random / maxint)? 
s :* sqr(vl) + sqr(v2); 
until s < 1? 

s :« sqrt(-2 * ln(s) / s) * vl; 
gauss :« s? 
end; 

procedure horintpol (row : longint); 

{Interpolates midpoints for 1 row) 
var 

i, col : longint; 
begin 
col ;= 0; 

while col < size do 
begin 

srf[row, col + step) (srf(row, col) + srf(row, col + 2 * step)) div 2; 
{New point) 

col :* col + 2 * step; 
end; 
end; 


procedure verintpol (col ; longint); 

(Interpolates midpoints for 1 column) 
var 

i, row : longint; 
begin 
row 0; 

while row < size do 
begin 

srf[row + step, col) :« (srf(row, col) + srf[row + 2 * step, col)) div 2? 
{New point) 

row :« row + 2 * step; 
end? 
end? 

procedure centintpol (row : longint)? 

{Interpolates center points for all cells in a row) 
var 

i, col : longint? 
begin 

col step? 
while col < size do 
begin 
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srf[row, col] := (srffrow, col - step] + srf[row, col + step] + srffrow - 
step, col] + srf[row + step, col]) div 4; 

(New point) 

col := col + 2 * step? 
end; 
end? 

procedure intpol? 

(Interpolates all midpoints at current step size) 
var 

i, row, col : longint? 
begin 
row := 0? 
col o? 

while row <= size do 
begin 

horintpol(row)? 
row := row + 2 * step; 
end? 

while col <= size do 
begin 

verintpol(col)? 
col := col + 2 * step? 
end? 

row : = step; 

while row <*= size - step do 
begin 

centintpol(row)? 
row :=* row + 2 * step; 
end ? 
end? 

procedure detail; 

(Adds random displacement to all points at current step size) 
var 

r, c, disp : longint? 
begin 
r : *= 0 ? 

while r <- size do 
begin 
c := 0? 

while c <* size do 
begin 

disp : = Round(100 * (gauss * stepfactor))? 
srf[r, c] :=* srf[r, c] + disp; 
c c + step; 
end; 

r := r + step? 
end; 
end? 

procedure newsurface? 
begin 

step := size; 

stepfactor exp(2 * H * ln(step))? 

srf(0, 0] :*= Round(100 * (gauss * stepfactor))? 

srf[0, size] := Round(100 * (gauss * stepfactor))? 

srf[size, 0] :« Round(100 * (gauss * stepfactor))? 

srf (size, size] :=* Round(100 * (gauss * stepfactor))? 

repeat 

step :=* step div 2? (Go to smaller scale) 
write('step = '); 
writeln(step)? 

stepfactor :** exp(2 * H * ln(step))? (Factor proportional to step size) 
intpol? 
detail? 

until step « 1? 
end? 

begin 

showtext; 

write('H - ?'); (Set roughness) 
readln(H)? 

open(srfile, NewfileName('Surface File')); 
st :=* tickcount? 
randseed :« st; (Randomize) 
newsurface? (Calculate surface) 
for row :* o to size do 
for col := o to size do 

write(srfile, srf[row, col])? (Store surface in file) 
close(srfile); 

st ;«* (tickcount - st) div 3600; 
write(st)? 


continued 
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NLDOS. DOM Accompanies "DOS in English,” by Alex Lane, 
MYTE, December 1987, page 261 


/*******************************************************************, 

/* 

NLDOS.DOM 


Copyright 1987, Alex Lane 
File 2 of 7. 

This file declares the user-defined domains used in the 
NLDOS program. 


V 

Z*******************************************************************^ 


DOMAINS 

worktok 


worklist 

stringlist 

symbolist 

charlist 


token(string)? 
p_token(string)? 
drive(string)? 
directory(string)? 
targetspec(string)? 
sourcespec(string)? 
targetfile(string)? 
filespec(string)? 
command(string); 
parameter(string); 
assignment(string) 
worktok * 
string * 
symbol * 
char * 


/********************** en( j Q f file ********************************/ 




NLDOS.SYN Accompanies ”DOS in English,” by Alex Lane, 
BYTE, December 1987, page 261 


/*******************************************************************/ 

/* 

NLDOS.SYN 

Copyright 1987, Alex Lane 
File 6 of 7. 

Synonyms for various commands, switches, and modifiers. 
Revision 1.1 

V 

/*******************************************************************/ 


CLAUSES 

v 

chaff( ("PLEASE”,”ME”,”YOU”,”THE”,”A”, ”DO", ”THAT”, ”ARE", "IS"]). 

c _syn( "DEL”, ("DELETE”, "KILL", "ERASE", "ZAP", "CHOP", "REMOVE"] ). 
C__syn( "COPY", ("COPY", "CLONE"]). 
c _syn( "CHDIR", ("CHDIR", "CD"]). 
c_syn( "REN", ("RENAME" ]). 

C_syn( "DIR", ("DIRECTORY","CATALOG", "SEE"]). 
c _syn( "TYPE", ("TYPE", "LIST", "VIEW"]). 
c _ s yn( "BACKUP", ("BACKUP"]). 

C_syn( "RESTORE", ("RESTORE"]). 

C_syn( "PATH", ["PATH"]). 
c _syn( "TIME", ("TIME"]). 

C_syn( "BREAK", ("BREAK"]). 
c __syn ( "DATE" , ( "DATE" ]) . 
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csyn( "PROMPT", ("PROMPT"]). 

c_syn( "SET", ["SET","ENVIRONMENT"]). 

f_syn( "ALL", ["ALL", "EVERYTHING", "ENTIRE", "COMPLETELY"]). 

f_syn( "SHOW", ["SHOW") ). 

fsyn( "DIRECTORY", ["DIRECTORY"]). 

f_syn( "SUBDIRECTORY", ["SUBDIRECTORY"]). 

f_syn( "AFTER", ["AFTER", "SINCE"]). 

f_syn( "FILE", ["FILES")). 

f_syn( "ON", [ "ON","IN"]). 

f_syn( "FROM", ["FROM", "SOURCE"]). 

f_syn( "TO", ["TO", "DESTINATION"]). 

f_syn( "CHANGE", ["CHANGE","GOTO"]). 

f_syn( "MAKE", ["MAKE", "CREATE"]). 

f_syn( "CONTENT", ["CONTENTS","LISTING")). 


d_syn( 

"/W", 

["/w", 

"WIDE", "MULTICOLUMN", "COLUMN"]) 

dsyn ( 

"/P", 

P/P", 

"PAUSE", "PAGE" )). 

b_syn( 

VS", 

P/S", 

"SUBDIRECTORY"]). 

b_syn( 

"/D:", 

P/D: 

", "AFTER"]). 

b_syn( 

"/M", 

P/M", 

"MODIFIED", "CHANGED"]). 

bsyn ( 

"/A", 

P/A", 

"ADD")). 

b_syn( 

"/P", 

[ "/P" 

, "PROMPT"]). 


/********************** end of file ********************************/ 


NLSIMPLE.DOC Accompanies "DOS in English," by Alex Lane, 
BYTE, December 1987, page 261 


NLSIMPLE.PRO: An Experiment in Natural Language Using Turbo Prolog 
by Rich Malloy, BYTE Magazine, August 1987 

This program is a very simple natural language interface for 

MS-DOS. For simplicity, it keeps all of its grammar rules in strings, 

and for that reason, is a bit slow. It also uses a context- 

free grammar with top-down parsing. This approach involves a 

large amount of backtracking, and thus can be somewhat 

inefficeint. The production rules (or rewrite rules) used by 

the grammar are functionally similar to context-free-grammar 

rules or to the Definite Clause Grammar (DCG) rules of standard C&M 

Prolog, but look a little different. For example, DCG rules 

look like: 

S -> NP VP 

VP -> VERB ADV NP 

The rules in this program look something like this: 

rule("S", "NP VP", "NP VP"). 

rule("VP", "VERB ADV NP", "VERB ADV NP"). 

rule("S", "help", "Consult the manual"). 

The first argument of the rule is similar to the left side of 
the DCG rule. The second argument is similar to the right side. 

As the system executes, it builds an internal representation of 
the input phrase until that representation matches the input 
exactly. If the first argument appear in that internal 
representation, it can be replaced with the second argument. 

The "S" is merely a start symbol. 

The third argument controls the output of the system. Just as 
an internal representation is being built, an output string 
is also being built. And, if match is found, and the first 
argument appears in the output string, then it is replaced by 
the third argument. 

In the above case, if the input were "help", the last rule 
would allow the internal representation "S" to match the input 
exactly. Then the output string, which starts as "S", would be 
replaced by "Consult the manual". 

Another difference between this approach and classic context- 
free grammars is that it uses semantic categories (e.g., 

ALLFILES, which stands for words such as "everything") instead 
of word categories such as Noun and Verb. 

If you choose the "rundos" mode rather than the "runtest" mode, 


continued 
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n,> * •*" ' III .. /I command to DOS. Unfortunately, Turbo Prolog 

' ' 11 ^ finishes a DOS command, making it 

v "‘’ h,n ' *" n directory. For that reason, this program 

' H m ih> commands to a batch file that ends with a pause 

. . lh « program then calls the DOS to execute that batch 

' ii. I'li 1 rt batch file approach would be useful also for 
• nI tons that reguire several DOS commands. 

A th® program works on the input phrase, it displays the words 
1,11 which it has found a match on the screen. If the program 
•loon not understand an input phrase, the first word that is 
not displayed is probably the one that caused the problem. 

The user should feel free to add more capabilities to the 
system. Commands such as BACKUP, FIND, SORT, etc. can be easily 
implemented. The user may also want to modify the "equals” 
predicate so that both uppercase and lower case input is 
accepted. 

Sample input (note all input must be lower case): 
show all files on b 

let me see all files on the main drive 

copy all files beginning with x from the main drive to b: 

When using the "rundos" version of the program, 
enter your command at the DOS prompt as follows: 

nlsimple show everything on the main drive 

To save keystrokes, you may want rename the executable 
version of the program with a shorter name. 


Note that in the program there are some rules for parsing 
simple mathematical phrases such as: 

A * B + C * D 

These rules can be easily expanded to handle more complicated 
phrases. Refer to most textbooks on AI for examples of how 
to build a context-free grammar to parse mathematical 
expressions. 


NL-READ.ME Accompanies "DOS in English," by Alex Lane 
BYTE, December 1987, page 261 


There are seven files for the natural-language-interface to DOS 
program outlined by Alex Lane in his article in the December 1987 
issue of BYTE. These are: 


NLDOS PRO 
NLDOS DOM 
NLDOS SYN 
NLRULES PRO 
NLTOKENS PRO 
NLDATE PRO 
NLUTILS PRO 


To use the program, run Turbo Prolog and load NLDOS.PRO. When you 
compile this file, it will load all of the other files. The 
program is currently set up to run in test mode. In this mode, it 
" ot iss V e < r onunand f to DOS, but simply displays the commands 
for the user 1 s inspection. Follow the instructions in the program 
and in Turbo Prolog for compiling an executable program that will 
feed commands to DOS. 


Also in this area is a somewhat smaller program called 

i^nr^h’ P M°»- th ?£ silnilar things using a context-free-grammar 

approach. Note that the grammar rules are stored as strings, and 
as such are relatively slow. The strings, however, are easy to 
modify. See NLSIMPLE.DOC for more details. y 
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NLUTILS.PRO Accompanies "DOS in English," by Alex Lane, 
BYTE, December 1987, page 261 


/*******************************************************************/ 

/* 

NLUTILS.PRO 

Copyright 1987, Alex Lane 
File 3 of 7. 

Utility predicates for NLDOS. 


V 

/*******************************************************************/ 


PREDICATES 

/* various permutations and combinations of ’member’-like predicates */ 

member(worktok, worklist) 
member(char, charlist) 
member(symbol,symbolist) 
member(string,stringlist) 
member_head(worktok, worklist, worklist) 
member_head(symbol,symbolist,symbolist) 
member_phrase(worklist, worklist) 
memberphrase(stringlist,stringlist) 

/* the standard 'append' predicate */ 

append(worklist,worklist,worklist) 
append(charlist,charlist,charlist) 
append(symbolist,symbolist,symbolist) 

repeat 

remove(string,stringlist,stringlist) 
remove(worktok,worklist,worklist) 
remove_once(worktok,worklist,worklist) 
removelist_once(worklist,worklist,worklist) 

CLAUSES 

member( X, [X|_J ). 

member( X, (_JY) ) member ( X, Y ) . 
member_head( X, [X|T], T ). 

member_head( X, [_|A], T ) member_head( X, A, T ). 
member__phrase( (), _ ). 

memberphrase( [H|T], [H|U] ) memberphrase( T, U ). 
memberphrase( X, (_|T] ) memberphrase( X, T ) . 


append([),L,L). 

append([X|LI],L2,[X|L3]) append(LI,L2,L3). 
repeat. 

repeat:-repeat, 
remove(_,(),()) J- !. 

remove(X,(X|T],F) !, remove( X, T, F )• 

remove(X,(A|T],(A|F]) remove( X, T, F). 

remove_once( (), () ) 1. 

remove_once( X, [X|T], T ). 

remove_once( X, [A|T], (A|F) ) remove_once( X, T, F ). 
remove_list_once( [], X, X ) !. 

remove_list_once( (H|T], L, F ) remove_once( H, L, FO ), 

remove_list_once( T, FO, F ). 

/********************** end of file ********************************/ 


continued 
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NLTOKENS.PRO Accompanies*"DOS in English," by Alex Lane, 
BYTE, December 1987, page 261 


/*******************************************************************/ 

/* 

NLTOKENS.PRO 

Copyright 1987, Alex Lane 
File 4 of 7. 

Tokenizer for NLDOS program. 

V 

/A******************************************************************/ 


PREDICATES 

backslash(char) 
colon(char) 
digit(char) 
dot_delim(char) 

get_token_list(string,worklist) 
letter(char,char) 

listtext(string, charlist) /* (i,o) */ 

list_textl(string,charlist,string) 
makeworktok(symbol,string,worktok) 

process_in_str(charlist,charlist,charlist,charlist) 
rest_token( charlist, charlist, worktok, charlist, symbol) 
string_delim(char) 

tokenize(charlist,worklist,worklist) 


CLAUSES 

get_token_list(String,Result) 

listtext(String,(Char|Tail)), trace(on), 
tokenize([Char|Tail], (), Result ). 

list_text( "", () ) :- !. 

listtext(String, (H|T] ) 
bound(String), 
frontchar(String,H,Rest), 
list_text(Rest,T). 

list_text(String, (H|T) ) 
bound(H), 

list_textl("",(H|T),String). 

list_textl( A, (), A ) :- !. 

list_textl( A, (H|T], Out ) :- 
str_char( Hs, H ), 
concat( A, Hs, AHs ), 
list_textl( AHs, T, Out ). 

tokenize([H|T),List,L ) :- 

letter(H, Letter),!, /* can be anything... */ 
rest_token(T,[Letter),Word,Rem, token), 
append(List,[Word],Nlist), 
tokenize(Rem,N1ist, L). 

tokenize([H|T), List, L ) 

backslash(H),!, /* seems to be a directory */ 

rest_token(T,(H),Num, Rem, dir), 
append(List,[Num],Nlist), 
tokenize(Rem,Nlist,L). 

tokenize([H|T), List, L ) :- 

dot_delim(H),!, /* seems to be an incomplete filespec */ 

rest^token(T,[H),Num, Rem, fspec), 
append(List,[Num],Nlist), 
tokenize(Rem,Nlist,L). 

tokenize([H|T], List, L ) 

string_delim(H),!, /* seems to be a string... */ 

rest_token(T,[H],Num, Rem, string), 
append(List,[Num],Nlist), 
tokenize(Rem,Nlist,L). 

tokenize([|T), List, L ) 

append(List,[assignment("-")],Nlist),l, 
tokenize(T,Nlist,L). 
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tokenize([_| T], List, L ) 

!, tokenize(T,List, L ). 

tokenize([],List,List ). 

process_in_str([H|T],L,T,L1) 
append(L,[H],LI). 

/* As long as you encounter letters in the current token, you 
continue to be what the head of the token modifier list 
says you are. The one exception is continuing to find letters 
once having established that a drive name has already been 
found. We are going to ASSUME that these letters belong to a 
file name. 

V 

rest_token( (H|T], List, Word, X, string ) :- /* special case?! */ 

H <> '\ M *,H <> '\\',!, 

append( List, [H], Nlist ), 

rest_token( T, Nlist, Word, X, string ). 

rest_token( ['\\'|T], List, Word, X, string ) /* special case?! */ 

append( List, [*\V], Nlist ), 
processinstr(T,Nlist,Tl,Nlistl),!, 
rest_token( Tl, Nlistl, Word, X, string ). 

rest_token( [H|T], List, Word, X, drive ) /* special case?! */ 

letter( H, Letter ),!, 
append( List, [Letter], Nlist ), 
rest_token( T, Nlist, Word, X, fspec ). 


rest_token( [H|T], List, Word, X, TL ) 
letter( H, Letter ),!, 
append( List, [Letter], Nlist ), 
rest_token( T, Nlist, Word, X,TL ). 

rest_token( [H|T], List, Word, X, __ ) 

colon( H ),!, /* have found a drive! */ 

append( List, [H], Nlist ), 
rest_token( T, Nlist, Word, X, drive ). 

rest_token( [H|T], List, Word, X, _ ) 

backslash( H ),!, /* have found a directory */ 

append( List, [H], Nlist ), 
rest_token( T, Nlist, Word, X, dir ). 

rest_token( [H|T], List, Word, X, _ ) 

dot_delim( H ),!, /* have found a filespec V 

append( List, [H], Nlist ), 

rest_token( T, Nlist, Word, X, fspec ). 

rest_token( [• •|T], List, Word, T, Token ) 
list_text( WordO, List ),!, 
makeworktok(Token,WordO,Word). 

rest_token( ['\ M, |T], List, Word, T, Token ) 
append (List, [ • \ Bt • ] ,Listl) , 
list^text( WordO, Listl ),!, 
makeworktok(Token,WordO,Word). 

rest__token( [ • — • |T], List, Word, (• —• |T] , Token) 
list_text( WordO, List ),!, 
makeworktok(Token,WordO,Word). 

rest_token( [_|T], List, Word, X, TL ) 

!, rest_token( T, List, Word, X, TL ). 

rest_token( [], List, Word, [], Token ) 

!, list_text( WordO, List ), 
makeworktok(Token,WordO,Word). 

makeworktok(token,A,token(A)). 

makeworktok(fspec,A,filespec(A)). 

makeworktok(drive,A,drive(A)). 

makeworktok(dir,A,directory(A)). 

makeworktok(string,A,parameter(A)). 

letter(C, D) 

C >= * a', C <- * z *, !, 
str_char(Cl,C), 
upper_lower(Dl,Cl), 
str_char(Dl,D). 

letter(C, C) 

C >- 1 A 1 , C <- »Z\ !; 

continued 
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digit(C),!; 

member(C,[•_•,•$•,•?•,»*','/• , •<•,•>»,»|•,*-»]). 

dot_delim('.'). 

backslash ('W ) . 
digit(C) :- 

C >=* 'O', C <= '9' . 

colon(':'). 

string_delim( 1 \"•). 

/********************** end of file ********************************/ 


NLDOS.DOC Accompanies "DOS in English," by Alex Lane, 
BYTE, December 1987, page 261 


This is a transcript of a session with NLDOS, a natural-language 
interface for DOS written for Turbo Prolog. It shows a series of 
input statements, and the resulting command generated by the 
program. Note that the transcript has been formatted for easier 
reading. The actual transcripts produced by the program should 
look a little different. 


>dir 

Command: DIR C:\AI\PROLOG 

>wide directory 

Rule fired: establish_dir_flags 

Command: DIR C:\AI\PROLOG /W 

>wide directory with pause 

Rule fired: establish_dir_flags 
Rule fired: establish_dir_flags 

Command: DIR C:\AI\PROLOG /W/P 

>direc 

Command: DIR C:\AI\PROLOG 

>page directory 

Rule fired: establish_dir_flags 
Command: DIR C:\AI\PROLOG /P 

>cat 

Command: DIR C:\AI\PROLOG 

>catalog 

Command: DIR C:\AI\PROLOG 

>directory *.* 

Command: DIR 

>show all files 

Rule fired: remove word_file 
Rule fired: show_f!le_to_dir 

Command: DIR C:\AI\PROLOG 

>copy ♦.* b: 

Command: COPY *.* C: \AI\PROI/>G 
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>copy all files to b: 

Rule fired: removewordfile 
Rule fired: establish_targetspec 

Command: COPY *?.* B: 

>copy all files from c: to a: 

Rule fired: remove_word_file 
Rule fired: establishtargetspec 
Rule fired: establishsourcespec 
Rule fired: establishsourcespec 

Command: COPY C:*?.* A: 

>delete all files on b: 

Rule fired: remove_word_file 

Rule fired: consolidatedrivefilespec 

Command: DEL B:*?.* 

>kill all .c files 

Rule fired: remove_word_file 
Rule fired: remove_word_file 

Command: DEL *.C 

>zap *.bak 

Command: DEL *.BAK 

>zap *.bak files 

Rule fired: remove_word_file 

Command: DEL *.BAK 

>restore all files in all subdir 

Rule fired: remove word_file 
Rule fired: establlsh_bac_flags 
Rule fired: establish_bac_flags 

Command: RESTORE A: *?.* /S 

>backup all files 

Rule fired: remove_word_file 

Command: BACKUP *?.* A: 

>backup all files to b: 

Rule fired: remove word_file 
Rule fired: establishtargetspec 

Command: BACKUP *?.* B: 

>backup all files in all subdir modified after 9/sep 

Rule fired: remove_word__file 
Rule fired: establlshbacflags 
Rule fired: establishbacflags 
Rule fired: establish_bac_flags 
Rule fired: establishbacflags 
Rule fired: establish_bac_flags 
Rule fired: establishbacflags 

Command: BACKUP *?.* A: /S/D:09-9-87 

>backup all modified files to a: 

Rule fired: remove_word_file 
Rule fired: establishtargetspec 
Rule fired: establishbacflags 

Command: BACKUP *?.* A: /M 


continued 
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>backup all modified .c files to a: 

Rule fired: remove_word_file 
Rule fired: remove_word_file 
Rule fired: establish_targetspec 
Rule fired: establishbacflags 

Command: BACKUP *.C A: /M 

>backup all .c modified in subdir to b: 

Rule fired: remove_word_file 
Rule fired: consolidatedrivefilespec 
Rule fired: establish_bac_flags 
Rule fired: establish_bac_flags 

Command: BACKUP B:*.C A: /M/S 

>backup foo.* to a: in all subd modif after l-jan-87 

Rule fired: establish targetspec 
Rule fired: establish_bac_flags 
Rule fired: establish_bac_flags 
Rule fired: establish_bac_flags 
Rule fired: establish_bac_flags 
Rule fired: establish_bac_flags 
Rule fired: establish_bac_flags 

Command: BACKUP FOO.* A: /S/D:01-1-87 

>what time is it 

Command: TIME 

>what time 

Command: TIME 

>time 

Command: TIME 

>show environ 
Command: SET 

>prompt 

Comma nd: PROM PT 

>show prompt 

Comma nd: PROMPT 

>show content of foo.bar 

Rule fired: show_content_to_type 

Command: TYPE FOO.BAR 

>ren foo.bar to sap.foo 

Rule fired: establish targetfile 

Command: Incomplete RENAME command. 

>rename foo.bar sap.foo 

Command: Incomplete RENAME command. 

>show environment 
Command: SET 

>environ 
Command: SET 

>env 

Command: SET 

>set 

Command: SET 
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>what date 
Command: DATE 

>show date 
Command: DATE 

-End- 


NLDATE.PRO Accompanies "DOS in English," by Alex Lane, 
BYTE, December 1987, page 261 


/a******************************************************************/ 

/* 

NLDATE.PRO 

Copyright 1987, Alex Lane 
File 5 of 7. 

Date finder. Given a token with a date embedded and 
delimited with or "/", takes a best shot at extracting 

a date. Finds year first, then month and day. European 
style (6-1-87 for January 6, 1987) fares poorly. 

Revision 1.2 (9/09/87) 


/*******************************************************************/ 

PREDICATES 

builddate(string,string) 

find_day(stringlist,stringlist,string) 

find_month(stringlist,stringlist,string) 

find_year(stringlist,stringlist,string) 

getparts(string,stringlist) 

month(string,string) 

normalize_year(integer,integer) 

CLAUSES 

builddate(Instring,Outstring) :- 

get_parts(Instring,Intokens), 
find_year(Intokens,01,Year), 
f ind_jmonth(01,02,Month) , 
find_day(02,_,Day) , 
concat(Month,,MP), 
concat(Day,,DP), 
concat(MP,DP,MDP), 
concat(MDP,Year,Outstring). 

getparts("",[)). 
get_parts( In, (D|SubOut) ) :- 
fronttoken(In,D,Rest), 
getparts(Rest,SubOut). 

findyear(In,Out,Y ) :- 
member(X, In ), 
str_int(X,XI), 
normalizeyear(XI,X2), 

X2 >- 80,!, 
str_int(Y,X2), 
remove(X,In,Out). 
find_year(X,X,"87"). 

normalize_year( In,Out) :- 
In >- 1980,!, 

Out = In - 1900. 
normalize_year(X,X) I*. 

find_month( In, Out, M ) :- 
month( M, Month ), 
str_len( Month, Mien ), Mien >« 3, 
member( X, In ), 
concat( X,_,Month), 
remove( X, In, Out). 


continued 
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fI ml mont h( In, Out, M ) 
m«mbor(X, In ), 
■tr int(X,XI), 

XI > 0, 

XI < 13, 
otr_int(M,Xl), 
remove(X,In,Out). 


find day( In, Out, M ) 
member(X, In ), 
str_int(X,Xl), 

XI > 0, 

< 32 t /* we don't do the "Thirty days hath..." bit */ 

str_JLnt (M,X1) , 
remove(X,In,Out). 


month( 

"01", 

"JANUARY"). 

month( 

"02", 

"FEBRUARY"). 

month( 

"03", 

"MARCH"). 

month( 

"04", 

"APRIL"). 

month( 

"05", 

"MAY"). 

month( 

"06", 

"JUNE"). 

month( 

"07", 

"JULY"). 

month( 

"08", 

"AUGUST"). 

month( 

"09", 

"SEPTEMBER"). 

month( 

"10", 

"OCTOBER"). 

month( 

"11", 

"NOVEMBER"). 

month( 

"12", 

"DECEMBER"). 

/*********** 

*********** end 


file ********************************/ 


NLRULES.PRO Accompanies "DOS in English," by Alex Lane, 
BYTE, December 1987, page 261 


/* / 

NLRULES.PRO 

Copyright 1987, ALex Lane 
File 7 of 7. 

Rules used to massage the token list in NLDOS. 

Revision 1.1 

V 

/********************************************^^^^^^^ 
PREDICATES / 

rule(symbol,worklist,worklist) 


CLAUSES 


rule( show_fi 1 e_ t o__dir, In, Out) 

. / . repl( [token("SHOW"),filespec("*?.*")), command("DIR"), in, Out ). 

rule( show_content_to_type, In, Out ) :- 7 7 

1 , ^ re S} ( [ token ("SHOW"),token("CONTENT")),command("TYPE"), In, Out), 
rule( dos_directory_commands, In, Out ) :- 

repl( [token("CHANGE"),command("DIR ")),command("CHDIR"), In, Out) 
repl((command("DIR "),token("PATH")],command("PATH"), In, Out). 
rule( removewordfile, Input,Output) 7 7 

member( token("ALL"), Input), 
member( filespec(A), Input), 

E - [token("ALL"),filespec(A)], 

concat("*",A,Al), 

member_phrase( E, Input), 

repl( E, filespec(Al), Input, Output); 

member(filespec(A),Input), 

repl([token("ALL"),filespec(A)),filespec(A),Input,Output); 
r e P l( [token("ALL”),token("FILE")], filespec("*?.*"),Input,Output); 
member(filespec(A),Input), v ' 

repl([filespec(A),token("FILE")],filespec(A),Input,Output). 
rule( consolidate drivefilespec, Input,Output) P 

member( fllespec(A), Input), 
member( drive(B), Input ), 
concat(B,A,C), 

E - [filespec(A),token("ON"),drive(B)], 
repl(E, filespec(C), Input, Output); 
member( filespec(A), Input), 
member( directory(B), Input ), 


90 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 









December 


concat(B,A,C), 

E = (filespec(A),token("ON"),directory(B)], 
repl(E, filespec(C), Input, Output). 
rule( establish targetspec, Input,Output) s- 
member(drive(B),Input), 

repl([token("TO"),drive(B)),targetspec(B),Input,Output)? 
member(directory(B),Input), 

repl( (token("TO'*) ,directory (B) ], targetspec (B) , Input,Output) . 
rule( establishsourcespec, Input,Output) 
member(drive(B),Input), 

repl((token("FROM”),drive(B)],sourcespec(B),Input,Output)? 
member(directory(B),Input), 

repl([token("FROM”),directory(B)),sourcespec(B),Input,Output)? 
member_phrase([filespec(A),sourcespec(B)],Input), 
concat(B,A,C), 

repl([filespec(A),sourcespec(B)),sourcespec(C),Input,Output). 
rule(establish_targetfile, Input, Output) 
member(filespec(A),Input), 

repl([token("TO"),filespec(A)],targetfile(A),Input,Output). 
rule( establish_dir_flags, Input, Output) 
member( command("DIR"), Input), 
d_syn(X,Y), 

checkout( Y, Input, Test), !, 

replace_tokens([token(Test)),parameter(X),Input,Output). 
rule( establish__bac_flags, Input, Output) 
isbackuporrestore(Input), 
b_syn(X,Y), 

checkout( Y, Input, Test ), !, 

replace tokens([token(Test))parameter(X),Input,Output); 

repl([parameter("/M")parameter("/D:")],parameter("/D:"),Input,Output) ? 

repl((token( M ALL"),parameter("/S")],parameter("/S"),Input,Output)? 

member(parameter("/D: M ),Input),!, 

member(token(A),Input), 

build_date(A,C), 

concat( "/D:", C,DC), 

replace_tokens((parameter("/D:")],parameter(DC),Input,Output). 
rule( find_filespec, Input, Output ) 

not ( member( filespec(_), Input ) ), 

replace_tokens([token("ALL")),filespec("*?.*"),Input,Output). 
rule( outofrules, X, X ) 
rule( __, X, X ) :- !. 

/********************** end of file ********************************/ 


NLSIMPLE.PRO Accompanies "DOS in English," by Alex Lane, 
BYTE, December 1987, page 261 


/************************************************************* 

NLSIMPLE.PRO: An Experiment in Natural Language Using Turbo Prolog 
by Rich Malloy, BYTE Magazine, August 1987 

This program is a very simple natural language interface for 
MS-DOS. For simplicity, it keeps all of its information in strings, 
and for that reason, is a bit slow. See NLSIMPLE.DOC for more 
details. 

Sample input (note all input must be lower case): 
show all files on b 

let me see all files on the main drive 

copy all files beginning with x from the main drive to b: 

For the sake of file safety, no format, delete, or erase commands 
have been implemented. 


**********************************************************/ 


domains 

symlist - symbol* 
file = batfile 
database 

lastword(integer) /* global var - points to last processed word */ 

predicates 

equals(string, string) 

matches(string, string, string, string, integer) 
rule(string, string, string) 

continued 
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procoss(string, string) 

mib(string, string, string, string) 

mid lead space(string, string, string) 

rnmove space(string, string) 

displayword(string, integer) 

runtest 

rundos 

goal 

runtest. /* for testing the program */ 
rundos. /* for controlling DOS */ 


clauses 

runtest if 

asserta( lastword(O) ), !, /* set global variable */ 

makewindow(1,7,7,"NLSIMPLE",0,0,18,79), /* set up window */ 

write( H ?> M ), /* write prompt */ 

readln(Input), 
process(Input, ), 
nl. 


rundos if 

asserta( lastword(O) ), !, /* set global variable */ 

comline(Input), 

process(Input, Output), 

openwrite(batfile, "NLSIMP99.BAT"), 

writedevice(batfile), 

write(Output), nl, 

write("pause”) , nl, 

closefile(batfile) , 

system("NLSIMP99") . 

process(Input,Output) if 
nl, 

write("Processing:"), nl, 

matches (Input, "S", "S", Temp, 1), /* "S" = Start symbol */ 

remove_space(Temp, Output), 
nl, nl, 

write("Command:"), nl, 
write(Output). 
process(Input, Output) if 

nl, nl, write("Sorry, I don't understand: Input, " "M . 

Output * " ". '' 


/* Rewrite rules - specifies how "S" can be rewritten */ 

/* The first argument of 'rule' can be rewritten as the second, 
and, if a match is found with the input, any occurence 
of the first argument in the output string should be 
rewritten as the third in the output. 

"!" is used to temporarily separate words that will 
later be adjoining. 


Abbreviations: 


s 

Sentence or Start symbol 

VP 

Verb phrase 

Q 

Question, such as, what 

H 

Help phrase 

SHOW 

Show Verb 

COPYV 

Copy verb 

DET 

Determiner, i.e., "the" 


rule("S", "VP", "VP"). 
rule("S", "Q", "Q"). 

rule("S", "H", "(Enter any phrase such as: let me see all files)"). 

rule("VP", "SHOW SOMEFILES ONDRIVE", "DIR ONDRIVE!SOMEFILES"). 

rule("VP", "SHOW ALLFILES ONDRIVE SOMEFILES", "DIR ONDRIVE!SOMEFILES"). 

rule("VP", "COPYV SOMEFILES ONDRIVE TODRIVE", 

"COPY ONDRIVE!SOMEFILES TODRIVE"). 
rule("VP", "COPYV SOMEFILES TODRIVE ONDRIVE", 

"COPY ONDRIVE!SOMEFILES TODRIVE"). 
rule("VP", "RENAMEV SOMEFILE NEWNAME", "RENAME SOMEFILE NEWNAME"). 
rule("VP", "change the name of SOMEFILE to NEWNAME", 

"RENAME SOMEFILE NEWNAME"). 
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rule("SHOW”, "show”, "") . 
rule("SHOW", "show me", 
rule("SHOW", "let me see", . 
rule("SHOW", "dir", . 
rule("SHOW", "catalog", 

rule("COPYV", "copy", ""). 
rule("RENAMEV", "rename", "") . 

rule("ALLFILES", "all files", ""). 
rule("ALLFILES", "everything", ""). 
rule("ALLFILES", "all", ""). 
rule("ALLFILES", "", ""). 

rule("SOMEFILES", "ALLFILES FILECONDITION", "FILECONDITION"). 

rule("SOMEFILES", "SOMEFILE", "SOMEFILE"). 

rule("SOMEFILE", "Wildcard*.*", "Wildcard*.*"). 

rule("SOMEFILE", "Wildcard.*", "Wildcard.*"). 

rule("SOMEFILE", "Wildcard", "Wildcard"). 

rule("SOMEFILE", "Wildcard.EXT", "Wildcard.EXT"). 

rule("SOMEFILE", "Wildcard:SOMEFILE", "Wildcard.EXT"). 

rule("EXT", "Wildcard", "Wildcard"). 

rule("NEWNAME", "as SOMEFILE", "SOMEFILE"). 

rule("NEWNAME", "SOMEFILE", "SOMEFILE"). 

rule("FILECONDITION", "beginning with Wildcard", "Wildcard*.*"), 
rule("FILECONDITION", "starting with Wildcard", "Wildcard*.*"), 
rule("FILECONDITION", "", "*.*"). 

rule("ONDRIVE", "on DRIVE", "DRIVE"), 
rule("ONDRIVE", "from DRIVE", "DRIVE"), 
rule("ONDRIVE", "DRIVE", "DRIVE"), 
rule("ONDRIVE", "", ""). 
rule("TODRIVE", "to DRIVE", "DRIVE"), 
rule("TODRIVE", "DRIVE", "DRIVE"). 

rule("Q", "what TIMEDATE is it", "TIMEDATE"). 
rule("Q", "what is the TIMEDATE", "TIMEDATE"). 
rule("Q", "what's the TIMEDATE", "TIMEDATE"). 
rule("Q", "what is today", "DATE"). 
rule("Q", "what is today's date", "DATE"), 
rule("TIMEDATE", "time", "TIME"), 
rule("TIMEDATE", "date", "DATE"). 

rule("H", "help", ""). 
rule("H", "help me", ""). 
rule("H", "?", ""). 
rule("H", "what can you do", ""). 

rule("DRIVE", "a:", "a:"). 

rule("DRIVE", "a", "A:"). 

rule("DRIVE", "a:", "A:"). 

rule("DRIVE", "b", "B:"). 

rule("DRIVE", "b:", "B:"). 

rule("DRIVE", "c:", "C:"). 

rule("DRIVE", "c", "C:"). 

rule("DRIVE", "d:", "D:"). 

rule("DRIVE", "d", "D:"). 

rule("DRIVE", "DET main drive", "C:"). 

rule("DRIVE", "DET main disk", "C:"). 

rule("DET", ""). 

rule("DET", "the", ""). 


/* Mathematical rewrite rules: 

These rules can be used to evaluate expressions such as 
A*B+C*D 

V 

/* 

rule("S", "Expr", "S(Expr)"). 

rule("Expr", "Exprl + Expr", "plus(Exprl, Expr)"). 
rule("Expr", "Exprl", "Exprl"). 

rule("Exprl", "Expr2 * Exprl", "mult(Expr2, Exprl)"). 
rule("Exprl", "Expr2", "Expr2"). 
rule("Expr2", "Var", "Var"). 


rule("Var", 

"A", 

"var(A)"). 

rule("Var", 

"B", 

"var(B)"). 

rule("Var", 

"C", 

"var(C)"). 

rule("Var", 

"D", 

"var(D)"). 


V 


continued 
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m( mIamnam */ 
.V 

(A, A) if I. 


' < i i iyu last word that has been successfully matched */ 

i | i-lay word (String, Num) if 
I mi tword(Lastnum), 

Num > Lastnum, 

fronttoken(String, Word, _), 
addleadspace(String, Word, Word2), 
retract( lastword(_) ), 
asserta( lastword(Num) ), 
lastword(Num), 
write(Word2), !. 
display_word(_, _). 


/* Matches: if first argument matches second, then fine. If not, 
clause searches for a substitution in the second such that the 
second will then match the first. The third and fourth are the 
initial and final output strings. The fifth argument points to 
the number of the word in the input string that is being processed */ 

matches("", x, X, ) . 

matches(SI, S2, Rl, R2, N) if /* heads of SI and S2 match */ 
fronttoken(SI, Slhead, Sltail), 
fronttoken(S2, Slhead, S2tail), 

N2 - N + 1, 
display_word(SI, N2), 
matches(Sltail, S2tail, Rl, R2, N2). 
matches(SI, S2, Rl, R2, N) if /* heads of S2 is a wildcard */ 
fronttoken(SI, Slhead, Sltail), ' 

fronttoken(S2, "Wildcard”, S2tail)„ 

N2 - N + 1, 
display_word(SI, N2), 
sub(Rl, "Wildcard", Slhead, R3), 
matches(Sltail, S2tail, R3, R2, N2) . 
matches(Sl S2, Rl, R2, N) if /* heads of SI and S2 can match */ 
fronttoken(S2, S2head, S2tail), ' 

rule(S2head, New_S2head, Newer S2head), 
sub(Rl, S2head, Newer_S2head, R3), 
concat(New_S2head, S2tail, New S2), 
matches(SI, New_S2, R3, R2, N). 


/* Substitution clauses */ 

/- fHUSSTi,*™ “ “ “• >~t .u 


"^sSSiSi 51 b * 5l “ ” lth ' <*— «* •/ 

remove_space(Sltail, S3), 
add_lead_space(Sl, S3, S2), !. 

remove space(SI, S2) if /* if not then don’t change it */ 
fronttoken(SI, Slhead, Sltail), 9 / 

remove__space(Sltail, S3), 
concat(Slhead, S3, S4), 
add_lead_space(Sl, S4, S2), !. 

remove_space(_, ••••) . /* if fir.t is space or empty, then end ioop */ 

/* Substitution clauses: if second argument is found in 

first, then third is substituted, yielding fourth */ 

sublsx' S2 i? first term empty, stop recursion */ 

^ / flrst word of S1 matches S2 */ 

fronttoken(Sl, Slhead, Sltail), ' 

Slhead « s2, 

sub(Sltail, S2, S3, S5), 
concat(S3, S5, S6), 
add_lead_space(SI, S6, S4), !. 

SUb ^SJ!?i, 84 i,i f ^ firSt W ° rd doesn,t match S2 */ 

fronttoken(SI, Slhead, Sltail), 

sub(Sltail, S2, S3, S5), 
concat(Slhead, S5, S6), 
add_lead_space(SI, S6, S4). 

7 * Add then d th2 L L the first ar 9 un >ent begins with spaces, 

selSnd argument */ concatenati °" those spaces with the 


add_lead_space(Sl, S2, S2) if 
frontchar(Sl, Possspace, ), 
not(char_int(Possspace, 32)), !. 
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add_lead_space(Sl, S2, S3) if /* if 

frontchar(SI, Poss_space, Sltail), /* 

charint(Poss space, 32), /* 

concat(" ", S2, S4), /* 

addleadspace(Sltail, S4, S3). 


space at front of SI, add */ 
add space to front of S2 */ 
to yield new S3 */ 
recursive until no space */ 


/****■*★* End program **************y 


NLDOS.PRO Accompanies "DOS in English," by Alex Lane, 
BYTE, December 1987, page 261 


/a******************************************************************/ 

/* 

NLDOS.PRO 

Copyright 1987, Alex Lane 

This program analyzes English-like command-line input and 
tries to develop the equivalent DOS command with correct 
parameters. 

The goal for experimentation in the Turbo Prolog environment 
does not actually issue the command to DOS. The goal that 
takes advantage of Turbo Prolog*s comline/1 predicate 
actually issues the command and should be used with this 
knowledge. The author cannot accept responsibility for 
lost or damaged files resulting from the operation of this 
program. 

File 1 of 7. 

Revision 1.2 (9/09/87) 

Sample input: 

show all files on b: 

copy everything to a: 

copy nl*.* to b: 

what time is it 

what is today's date 

copy everything from c: to b: 

When using the "rundos" version of the program, 
enter your command at the DOS prompt as follows: 

nldos show all files on b: 


V 

/A******************************************************************/ 

code=*3000 

include "nldos.dom" 


DATABASE 

b_syn( string, stringlist ) 
c_syn( string, stringlist ) 
d_syn( string, stringlist ) 
f_syn( string, stringlist ) 
chaff( stringlist ) 


/* backup/restore synonyms */ 
/* command synonyms */ 

/* directory flags */ 

/* flag synonyms */ 


PREDICATES 


catenate 2(string,string,string,string) 
catenate_3(string,string,string,string,string) 
checkout(stringlist,worklist,string) 
commandparams(string,worklist,string) 
cullchaff(worklist,worklist) 
find_command(worklist,worklist) 
gather_flags(worklist,string) 
get_backup_source(worklist,string,worktok) 
getbackuptarget(worklist,string) 
get_copy_source(worklist,string,worktok) 
getcopytarget(worklist,string) 
getdirtarget(worklist,string) 
getrestoresource(worklist,string) 
get restore_target(worklist,string) 
is_backup_or_restore(worklist) 


continued 
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nmkn rommnnd(worklist,string) 
nw»ufM«|n (worklist, worklist) 
i <’i , M m(worklist,worklist) 

»«’pl (worklist,worktok,worklist,worklist) 

i<^l tcotokens(worklist,worktok,worklist,worklist) 

runtest 

rundos 

?;tandardize_words (worklist, worklist) 
include "nlutils.pro" 
include "nltokens.pro" 
include "nldate.pro" 


GOAL 


runtest. /* to test the program */ 

/* 

rundos. /* to issue real DOS commands */ 

V ' 

include "nldos.syn" 
include "nlrules.pro" 

CLAUSES 


/* 9oal for experimentation within the Turbo Prolog environment */ 
runtest if 

makewindow(l,7,7,"",0,0,15,80), 

repeat, 

write(">”), 

readln(In), 

get_token_list(In, T), 
cullchaff(T,T0), 
standardize words(TO,Tl), 
find command(Tl,B), 
massage(B,C), 
make_command(C,Command), 
write("Command: ", Command),nl, 

fail. 


/* goal for execution from DOS prompt */ 

rundos if 

comline(In), 
get_token__list(In,T) , 
cull_cha f f(T,TO), 
standardize_words(TO,Tl), 
find_command(Tl,B), 
massage(B,C), 
make_command(C,Command), 
write("Command: ",Command),nl, 

/* system(Command), */ 

/* V 

/* WARNING! Do not uncomment the system() call */ 
/* unless you want the program to actually */ 

/* perform the command on your computer. */ 

/* */ 

/***************************************************/ 

write("Your wish is my command "), nl. 


catenate_3(B,C,D,E,F) 

concat(B,C,BO), 
concat(BO," ",BC), 
catenate_2(BC,D,E,F). 
catenate_2(C,D,E,F) 

concat(C,D,CO), 
concat(CO," ",CD), 
concat(CD,E,F). 


standard!ze_words(Input,Output) :- 
f_syn(X,Y), 

checkout (Y, Input,Test),!, 

replace_tokens([token(Test)],p_token(X),Input,Out), 
standardize_words(Out,Output),!. 
standardize_words(Input,Output) 
reform(Input,Output). 


cullchaff(Input,Output) 
chaff(Y), 

checkout (Y, Input,Test),!, 


% BYTE LISTINGS SUPPLEMENT • OCTOBER-DF.CEMBER, 1987 



December 


remove(token(Test),Input,Out), 
cullchaff(Out,Output). 
cull_chaff(X,X) !. 

reform(Input,Output) 

member(ptoken(X),Input), 

replacetokens((ptoken(X)],token(X),Input,Out), 
reform(Out,Output). 
reform(X,X) !. 


find_command(Input,Output) :- 
c_syn(X,Y), 

checkout(Y,Input,Test),!, 
replace_tokens((token(Test)) 
find_command(X,X) !. 

massage(In, Out) 

rule(A,In,OutO), 

A <> "out_of_rules", 
write("Rule fired: ",A),nl, 

massage(OutO,Out),1. 


command(X),Input,Output). 


/* this line may be commented out 
for aesthetic purposes */ 


massage(X, X ) 

checkout(Y,Input,Test) 
member(Z,Y), 

member(token(Test),Input), 
str_JLen(Test,Testlen) ,Testlen >=2, 
concat(Test,_,Z) , !. 


replace_tokens( [R|S], Replacement, Origlist, NewList ) 
remove_list__once(S, OrigList, IntList ), 
member_head( R, Intlist, T ), 
append( H, [R|T], Intlist ), 
append( H, (Replacement|T], NewList ). 

repl( Phrase, Replacement,Input, Output ) 
member_phrase(Phrase,Input), 

replace_tokens(Phrase,Replacement,Input,Output),!. 

is_backup_or_restore(Input) 

member( command( "BACKUP" ), Input); 
member( command( "RESTORE" ), Input). 

get_copy_source(Input,D,sourcespec(D)) :- 

member( sourcespec(D), Input ),!. 

get_copy_source(Input,D,filespec(D)) 
member( filespec(D),Input). 

get_copy_target(Input, D) 

member( targetspec(D), Input),!? 
member( filespec(D),Input),!? 
disk(D). 

get_diretarget(Input, D) 

member( targetspec(D), Input),!? 
member( filespec(D), Input),!? 
member( directory(D), Input),!; 
member( drive(D), Input),!; 
disk(D). 

getbackuptarget( Input, D) 

member( targetspec(D), Input ),!? 
member( drive(D), Input),!? 

D» "A: H . /* default */ 

getbackupsource( Input, D, sourcespec(D)) 
member( sourcespec(D), Input),!. 

get_backup_source( Input, D, filespec(D)) :- 
member( filespec(D), Input). 

get_restore_source( Input, D) 

member(sourcespec(D),Input),!? 
member(drive(D),Input),!? 

D - "A:". 

get_restore_target(A,B) getcopytarget(A,B). 

gather_flags( Input, D) 

member( parameter(S), Input ), 
remove( parameter(S), Input, InputO), 


continued 
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f i.»• in ( inputo, c), 

mmm* kI (n, c, D). 

• i i , "") : - !. 


• mmiiiii ii<i(input,Command) 
writn(Input),nl, 
mninbor ( command (A), Input), !, 

< <>mmand_params( A, Input, Command ). 


imimd_params( "TIME”, _, "TIME" ). 
i»mmand_params ( "PATH", ”, "PATH" ). 

<ommand~params( "BREAK", _, "BREAK" ). 
command_params( "DATE", _, "DATE" ). 
command_params( "PROMPT", _, "PROMPT"), 
commandparams( "SET", _, "SET"). 

command_params( "DEL", Input, Outstring ) 
member( filespec(B), Input ), 
concat( "DEL ", B, Outstring ),!? 
Outstring = "Incomplete DELETE command.". 


commandparams( "COPY", Input, Outstring ) 
getcopysource( Input,A,B), 

member( B, Input ), /* we NEED a filespec */ 

remove( filespec(A), Input, Inputl), 

get copy_target( Inputl, Target ), /* either a target or default 

catenate__2 ( "COPY ",A, Target, Outstring),!? 

Outstring = "Incomplete COPY command.". 


command__params( "CHDIR", Input, Outstring ) 
member( targetspec(A), Input ), 
concat( "CHDIR ", A, Outstring ),!? 

Outstring = "Incomplete CHDIR command.". 

command_params( "REN", Input, Outstring ) 
member(filespec(A), Input), 
member(targetfile(B), Input), 
catenate 2( "REN ",A,B, Outstring),!; 
member(filespec(A), Input), 
member(filespec(B) , Input), 
boa, 

catenate 2( "REN ",A,B, Outstring),!? 

Outstring ■ "Incomplete RENAME command.". 

command_params( "TYPE", Input, Outstring ) 
member(filespec(A),Input), 
concat( "TYPE ", A, Outstring),!? 

Outstring = "Incomplete TYPE command.". 

command params( "DIR", Input, Outstring ) 
get_dir_target( Input, Target), 
gatherflags(Input,Flags), 

catenate_2( "DIR ", Target, Flags, Outstring ),!; 

Outstring = "Incorrect DIRECTORY command.". 

command params( "BACKUP", Input, Outstring ) 
get_backup_source( Input, Source, s), 
remove(S,Input,Inputl), 
get_backup_target(Inputl,Target), 
gatherflags(Input,Flags), 

catenate_3( "BACKUP ",Source,Target,Flags, Outstring),!? 
Outstring - "Incorrect BACKUP command.". 

command_params( "RESTORE", Input, Outstring ) 
get_restore_source( Input, Source ), 
get_restore_target( Input, Target ), 
gather_flags( Input, Flags), 

catenate^ "RESTORE ", Source,Target,Flags, Outstring),!? 
Outstring ■ "Incorrect RESTORE command.". 

/********************** end of file o***********o************o***/ 


SCR0LL Z0 °M.C, Contributed by Jim Kent. Accompanies BYTE's review 
of the Atari Mega 4, December 1987, page 153 


/* scrollzoom.c - a little test program to excercise the blitter'j 
smudge bit to do a zoom in lo-res */ 

^include <osbind.h> 
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scroll_zoom_screen() /* blow up screen and scroll up and down it */ 

( 

static char sbuffer[32000]; 
char *screen; 
int i; 

screen = Physbase(); 

copy_screen(screen, sbuffer); /* make copy of screen for source */ 

/* scroll down left side */ 

for (i=*0; i<150? i++) 

zoomblit(sbuffer+160*i, screen, 50); 

/* scroll up left side */ 

for (i=*150; i>«0; —i) 

zoomblit(sbuffer+160*i, screen, 50); 

/* scroll down right side */ 
for (i=0; i<150; i++) 

zoomblit(sbuffer+160*i+80, screen, 50); 

/* scroll up right side */ 
for (i=*150; i>=*0; —i) 

zoomblit(sbuffer+160*i+80, screen, 50); 

) 

main() 

( 

int blt_status; 

if (Getrez() i- 0) 

{ 

puts("can only work on low res screens*'); 
exit(0); 

) 

blt_status = _xbios(64,-1); /* inquire blitter state */ 

if ((blt_status&3) == 3) 

(, 

scroll_zoom_screen(); 

) 

else 

( 

if (blt_status&2) 

puts("Blitter not active on Desktop"); 

else 

puts("No blitter installed"); 

exit(0); 

) 

) 


ZOOMBLIT.ASM, Contributed by Jim Kent. Accompanies BYTE's review 
of the Atari Mega 4, December 1987, page 153 


public _zoomblit 
;_zoomblit 

;zoomblit(source, dest, linecount) 

; does a 4x zoom in lo-res with the blitter. 

; dest should point to a 32K screen 

; source and dest must not overlap. 


zoomblit 

zbregs reg 

a2/d2 ; preserve registers trashed except do 

firstp set 

4+4*2 ; offset to first parameter 

source set 

firstp 

dest set 

firstp+4 

linecount set 

firstp+8 

movem.1 

zbregs,-(sp) 

lea 

zbsource(pc),a2 

move.1 

source(sp),(a2)+ 

move.1 

dest(sp),(a2)+ 

move.w 

linecount(sp),(a2)+ 

pea 

zoomblit 

trap!438 

move.w 

#38,-(sp) 

trap 

#14 

addq 

#6, sp 

movem.1 

(sp)+,zbregs 

rts 


continued 
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Khnourco 
r.lxtnnt 
/.bcount 
I>at4 dc.w 
dc. w 


dc. 1 0 
dc. 1 0 
dc.w 0 

$0000,$000f,$00f0,$00ff,$0f00,$OfOf,$0ffO,$Offf 
$f000,$f00f,$f0f0,$f0ff,$ff00,$ff0f,$fff0,$ffff 


BLiTTER BASE ADDRESS 


BLiTTER equ $FF8A00 

; BLiTTER REGISTER OFFSETS 


Halftone 

Src_Xinc 

SrcYinc 

Src_Addr 

Endmaskl 

Endmask2 

Endmask3 

DstXinc 

DstYinc 

Dst_Addr 

XCount 

YCount 

HOP 

OP 

Line_Num 

Skew 


fLineBusy 

fLineHog 

fLineSmudge 

mHOP_Source 
mHOP_Ha1ftone 

mSkewFXSR 

mSkewNFSR 

mLineBusy 

mLineHog 

mLineSmudge 

zoomblit 


equ 0 

equ 32 

equ 34 

equ 36 

equ 40 

equ 42 

equ 44 

equ 4 6 

equ 4 8 

equ 50 

equ 54 

equ 56 

equ 58 

equ 59 

equ 60 

equ 61 


equ 7 

equ 6 

equ 5 

equ $02 

equ $01 

equ $80 

equ $40 

equ $80 

equ $40 

equ $20 


; find the blitter 
move.1 #BLiTTER,a1 

move.1 al,a2 

?stuff the pattern buffer 
lea pat4(pc),a0 

move.1 (a0)+,(a2)+ ;stuff 16 words of pattern buffer with 

move.1 (a0)+,(a2)+ ;the zoom 4x pattern 

move.1 (a0)+,(a2)+ 

move.1 (aO)+,(a2)+ 

move. 1 (a0)+, (a2) + 

move.1 (a0)+,(a2) + 

move.1 (aO)+,(a2)+ 
move.1 (aO)+,(a2)+ 

;all end masks on always... 

#-l,do 

dO,Endmaskl(al) 
dO,Endmask2(al) 
dO,Endmask3(al) 

Line_Num(al),a0 ; point aO to "on" switch 
# 7 /d0 ; load in busy bit# 

; now fetch source dest and linecount parameters. Pc relative 

? so can cope with no a5 global data pointer inside software interrupt 

move.1 zbsource(pc),dl 

move.1 zbdest(pc),a2 

move.w zbcount(pc),d2 

add.w #l,d2 ; d2 was line-count minus 1 


move.w 
move.w 
move.w 
move.w 

lea 

move.w 


? set up parameters for initial 16 blits. These are grouped in 
? four sets of four. Each set takes care of one bit-plane. 

; Within a set each blit will take a nibble of the source to 


100 BYTE LISTINGS SUPPLEMENT • OCTOBER-DECEMBER, 1987 




December 


? a word in the dest. 


move.w 

move.w 

move.w 

move.w 

move.w 

move.b 
move.b 

#8,Src Xinc(a'l) ? hit every word of source plane 

#120+8,Src_Yinc(al) 

#32,Dst Xinc(al) ? every 4th word of dest plane 

#32+(160*3),Dst Yinc(al) 

#5,X Count(al) 

#mHOP Halftone,HOP(al) 

#3,OP(al) 


;now go do the zoom in the x direction 
bsr zplane 


add. 1 

adda 

bsr 

add. 1 

adda 

bsr 

add. 1 

adda 

bsr 

#2,dl 

#2,a2 

zplane 

#2, dl 

#2,a2 

zplane 

#2,dl 

#2,a2 

zplane 


?at this point every 4th line of the dest screen has been zoomed. 
;we want to replicate lines. 1*11 do this in 3 steps. Copy line 
;0 to line 1, then linel to line2, and last line 2 to line 3. 


move.w 

move.w 

move.w 

move.w 

move.w 
move.b 
move.b 
move.b 

#2,Src__Xinc(al) ;do copy as if single-bitplane image in one pass 
#480+2,Src__Yinc(al) ; skip 3 lines 
#2,Dst Xinc(al) 

#480+2,Dst Yinc(al) 

#80,X_Count(al) 

#mHOP Source,HOP(al) 

#3,0P(al) 

#0,Skew(al) 

suba 

bsr 

bsr 

bsr 

rts 

#6,a2 

rpl_line 

rplline 

rplline 


? take a nibble to a word 4 times to cover all nibbles in 
? source word. 


zplane 

move.1 
move.b 
adda 
move.1 
move.w 
move.b 

restartl 

bset.b 

nop 

bne 

dl,Src Addr(al) 

#0,Skew(al) 

#24,a2 

a2,Dst_Addr(al) 
d2,YCount(al) 

#mLineBusy+mLineSmudge,(aO) 

do, (aO) ? see if busy 

restartl 

move.1 
move.b 
suba 
move.1 
move.w 
move.b 

restart2 

bset.b 

nop 

bne 

dl,Src_Addr(al) 

# 4,Skew(a1) 

#8,a2 

a2,Dst_Addr(al) 
d2,YCount(al) 

#mLineBusy+raLineSmudge,(aO) 

dO,(aO) ? see if busy 

restart2 

move.1 
move.b 
suba 
move.1 
move.w 
move.b 

restart3 

bset.b 

nop 

bne 

dl,Src_Addr(al) 

#8,Skew(al) 

#8,a2 

a2,DstAddr(al) 
d2, Y__Count (al) 

#mLineBusy+mLineSmudge,(aO) 

dO,(aO) ; see if busy 

restart3 

move.1 
move.b 
suba 

dl,Src Addr(al) 

#12,Skew(al) 

#8,a2 


continued 
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wmVm.)« 

M 

hivnl ,ll 
nap 
)mi« 
r t® 


*d , I'mI AiMt (A t) 

*1 >, V Pmiitl' (•» i) 

*••1 t MMitnny • mi,inc’.'.mudga, (aO) 

•10, (a()) ; see if busy 


restart4 


rpl line 

move.1 
adda.w 
move.1 
move.w 
move.b 

restart5 

bset.b 

nop 

bne 

rts 


a2,Src_Addr(al) 

#160,a2 

a2,Dst_Addr(al) 
d2,YCount(al) 

#mLineBusy,(aO) 

dO,(aO) ; see if busy 


restarts 


public _copy_screen 
?copy_screen(s, d) 

? copy 32K screen pretty fast, but not with blitter 

_copy_screen 

move.1 4(sp),a0 
move.1 8(sp),al 

move.w #999,dO ?32bytes/loop x 1000-1 

cslp 

move.1 (aO)+,(al)+ 
move.1 (aO)+,(al)+ 
move.1 (aO)+,(al)+ 
move.1 (aO)+,(al)+ 
move.l (aO)+,(al)+ 
move.1 (aO)+,(al)+ 
move.l (aO)+,(al)+ 
move. 1 (aO) + , (al)>»- 
dbra do, cslp 
rts 


X386B1.C Accompanies SCO XENIX 386 by Edwin J. Lau, BYTE, December, 
1987, page 190 


/* This is Xenix benchmark program 1 */ 

#include <stdio.h> 

#include <malloc.h> 

#include <sys/types.h> 

#include <sys/times.h> 

main(argc, argv) 
int argc? 
char *argv[]? 

( 

extern int optind? 
extern char *optarg; 

int c, errflag, fd, wnum, i, id, size? 
char *mptr? 
struct tms tp; 
long etl, et2; 

size » 0? 
wnum - 50? 
errflag « 0? 

while ((c - getopt(argc, argv, "n:")) 1- EOF) 
switch(c) { 
case 'n's 

wnum « atoi(optarg)? 

#ifdef DEBUG 

printf (»'write %d times\n M , wnum) ; 

#endif 

break? 

case •?•: 

errflag ■ 1? 
break? 

) 
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if (errflag) ( 

printf ("Usage: xbl (getpid) ( -n count ] \n")? 
exit(1)? 

) 

etl » times(&tp)? 
for (i - 0; i < wnuro; i++) { 
id = getpid(); 

) 

et2 = times(&tp); 

printf("elapse time getpid (sec) = %f\n", (float) (et2 - etl)/50.)» 


X386B2.C Accompanies SCO XENIX 386 by Edwin J. Lau, BYTE, December, 
1987, page 190 


/* This is Xenix benchmark program 2 */ 

#include <stdio.h> 

#include <malloc.h> 

#include <sys/types.h> 

#include <sys/times.h> 

char bss[32768); 

main(argc, argv) 
int argc; 
char *argv[]; 

{ 

extern int optind? 

extern char *optarg? 

int c, errflag, fnum, i, id? 

struct tms tp; 

long etl, et2? 

char *mptr? 

fnum = 50; 
errflag - 0? 

while ((c = getopt(argc, argv, "n:f:")) !** EOF) 
switch(c) ( 
case ' n': 

fnum = atoi(optarg)? 

#ifdef DEBUG 

printf("fork %d times\n", fnum)? 

#endif 

break? 

case •?•: 

errflag = 1? 
break; 

) 

if (errflag) { 

printf("Usage: xb2 (fork) [ -n count ) \n")? 
exit(1)? 

) 

etl - times(&tp); 
for (i - 0? i < fnum? i++) ( 
if ((id - fork()) ~ 0) ( 

/* This is the child process */ 
exit(0)? 

) 

) 

et2 = times(&tp); 

printf("fork + 32k heap elapse time (sec) - %f\n", 
(float) (et2 - etl)/50.)? 

) 


X386B3.C Accompanies SCO XENIX 386 by Edwin J. Lau, BYTE, December, 
1987, page 190 


/* This is Xenix benchmark program 3 V 
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I hjretnbo 


I i to I ihIm * *<i (i lo. h> 

I ho I iol« • Hid 1 I oc. h> 

Iho'holo • fiy»i/types.h> 

I ho Itnle .yn/times.h> 

»•»«i n(m gc, argv) 

I mi <irgc; 

< Imr *argv[); 

( 

extern int optind? 
extern char *optarg; 

int c, errflag, fd, wnum, i, id, size; 
char *mptr? 
struct tms tp? 
long etl, et2; 


size = 0; 
wnum *= 50; 
errflag = 0; 

while ((c = getopt(argc, argv, "n:s:")) != EOF) 
switch(c) { 
case 'n': 

wnum = atoi(optarg); 

#ifdef DEBUG 

printf("write %d times\n", wnum); 

#endif 

break; 


#ifdef 

#endif 


case 's': 

size = atoi(optarg); 
printf("size = %d \n", size); 

DEBUG 

printf("size = %d \n", size); 
break; 


case '?': 

errflag » 1; 
break; 

} 

if (errflag || (size ==* 0)) ( 

printf("Usage: xb3 (write) [ -n count 1 -s size \n"); 
exit(1); 1 

) 

if ((fd = creat("junk", 0644)) == -1) { 
printf("error: can't create file\n"); 
exit(1); 

) 

mptr = malloc(size); 

for (i =* 0; i < size; i++) mptr[i] = 'a'; 
etl = times(&tp); 
for (i =» 0; i < wnum; i++) ( 
write(fd, mptr, size); 

> 

et2 = times(&tp); 

printf("elapse time write (sec) - %f\n", (float) (et2 - etl)/ 50 .); 


<386B4.C Accompanies SCO XENIX 386 by Edwin J. Lau, BYTE, December. 
L987, page 190 


/* This is Xenix benchmark program 4 */ 
Ifinclude <stdio.h> 

I/include <malloc.h> 

#include <sys/types.h> 

#include <sys/times.h> 

main(argc, argv) 
int argc; 
char *argv(]; 

{ 

extern int optind; 
extern char *optarg; 

int c, errflag, fd, wnum, i, id, size; 
char *mptr; 
struct tms tp; 
long etl, et2; 
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size = 0; 
wnum = 50; 
errflag = 0; 

while ((c *= getopt(argc, argv, "n:s:")) != EOF) 
switch(c) { 
case 'n': 

wnum = atoi(optarg); 

Ufdef DEBUG 

printf("write %d times\n", wnum); 

#endif 

break? 
case 's’: 

size = atoi(optarg)? 

Ufdef DEBUG 

printf( M size = %d \n", size)? 

#endif 

break? 

case '? 1 : 

errflag = 1? 
break; 

) 

if (errflag || (size ==0)) ( 

printf("Usage: xb4 (read) [ -n count ) -s size \n")? 
exit(1); 

) 

if ((fd = open("junk", 0644)) ==* -1) ( 
printf("error: can't open file\n")? 
exit(1)? 

) 

mptr * malloc(size); 

for (i - 0? i < size; i++) mptrfi] » 'a'? 

etl - times(&tp); 
for (i = 0? i < wnum? i++) ( 
read(fd, mptr/ size)? 

} 

et2 ■ times(&tp)? 

printf("elapse time read (sec) ■ %f\n", (float) (et2 - etl)/50.)? 


X386B5.C Accompanies SCO XENIX 386 by Edwin J. Lau, BYTE, December, 
1987, page 190 


/* This is Xenix benchmark program 5 */ 

^include <stdio.h> 

#include <sys/types.h> 

Unclude <sys/times.h> 

main(argc, argv) 
int argc? 
char *argv[]? 

( 

extern int optind? 
extern char *optarg? 

int c, errflag, fd, wnum, i, id, size; 
char ♦mptr? 
struct tms tp? 
long etl, et2? 

wnum » 50? 
errflag = 0? 

while ((c = getopt(argc, argv, "n:s:")) EOF) 
switch(c) { 
case 'n': 

wnum ■ atoi(optarg)? 

Ufdef DEBUG 

printf("write %d times\n", wnum); 

Hendif 

break? 


case •7•s 

errflag - 1? 
break? 


continued 
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1 1 (wnum - 0) ( 

l»i intf (“Usage: xb5 (screenl) -n size \n") ; 

«‘xit(l) ; 

) 

etl *= times(&tp); 
for (i = 0; i < wnum; i++) { 
printf("x")? 

) 

et2 = times(&tp); 

printf("elapse time write (sec) = %f\n", (float) (et2 - etl)/50.); 


C386B6.C Accompanies SCO XENIX 386 by Edwin J. Lau, BYTE, December, 
1987, page 190 


'* This is Xenix benchmark program 6 */ 

I include <stdio.h> 
finclude <sys/types.h> 

I include <sys/times.h> 

nain(argc, argv) 
int argc? 
zhar *argv[]; 

( 

extern int optind? 
extern char *optarg; 

int c, errflag, fd, wnum, i, id, size; 
char *mptr? 
struct tms tp; 
long etl, et2; 

wnum = 50; 
errflag * 0; 

while ((c - getopt(argc, argv, "n:s:")) !- EOF) 
switch(c) { 
case 1 n*: 

wnum = atoi(optarg); 

#ifdef DEBUG 

printf("write %d times\n", wnum); 

Hendif 

break; 

case 1 ?•s 

errflag * 1; 
break; 

) 

if (errflag ) { 

printf("Usage: xb6 (screen2) ( -n count ) \n"); 
exit(1) ; 

) 

etl =* times(&tp); 

for (i * 0; i < wnum; i++) ( 

printf("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

”)? 

) 

et2 « times(&tp); 

printf("elapse time write (sec) - %f\n", (float) (et2 - etl)/50.); 


FERRET.ASM accompanies "Ferret: An Image Processor" by Clifford Harris, 
BYTE, December, 1987, page 317. 


PROGRAM FERRET 

THIS IS THE PROGRAM FOR IMAGE PROCESSING 
RCA SID-504 CCD IMAGE 
by 

Clifford Harris 
99 Mason Rd. 

Yerington, Nv. 89447 

This version does not include the telescope controller. 
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ROWS 

= 403 


COLUMNS 

= 256 

* MUST BE MULTIPLE OF 16 

BASEROW 

= 70 


BASECOL 

= 0 


TOPROW 

= BASEROW+403 


BASECOL1 

= 64 


BASECOL2 

= 336 


A D DATA 

= $FF0000 

♦A/D CONVERTER 

IOBASE 

= $FF0000 

♦BASE ADDRESS I/O BLOCK 

SIO 

* IOBASE+$70 

♦BASE ADDRESS INTERFACER 4 BOARD 

VECOUT 

* SIO 

♦INTERFACER 4 DATA REGISTER 

VECSTAT 

« SIO+1 

*14 STATUS REG 

MODE 

= SIO+2 

*14 MODE REG 

COMMAND 

= SIO+3 

*14 COMMAND REG 

SELECT 

= SIO+7 

*14 SELECT REG 

PARDATA 

= SIO+2 

*14 PARALLEL DATA REG 

SYSBASE 

= IOBASE+$50 

♦BASE ADDRESS SYSTEM SUPPORT 1 

SYSIO 

- SYSBASE+$C 

♦SYSTEM SUPPORT CONSOLE DATA REGISTER 

SYSST 

= SYSBASE+$D 

♦SYSTEM SUPPORT CONSOLE STATUS REG 

MATHDATA 

= SYSBASE+8 

♦MATH CHIP DATA REGISTER 

MATHCMD 

- SYSBASE+9 

♦MATH CHIP COMMAND REG 

CLKCMD 

- SYSBASE+$A 


CLKDATA 

* SYSBASE+$B 


.TEXT 

********* 


* 

TOP MENU 


PGM: 

JSR 

VECINIT 


MOVE.L 

#$FFFFFFFF,BADMAP 

MOVE.W 

#170,FRAMEY 

* X,Y STARTS FRAME NEAR MIDDLE 

MOVE.W 

#400,FRAMEX 


MOVE.W 

#1,EXPOSURE 


MOVE.B 

#$30,EXPTIME1 


MOVE.B 

#$30,EXPTIME2 


MOVE.B 

#$30,EXPTIME3 


MOVE.B 

#$31,EXPTIME4 


MOVE.B 

#2,HORTIME 


MOVE.B 

#56,VERTIME 


MOVE.B 

#40,ADTIME 


JSR 

TEST 


MOVE.B 

# 'Q*,VECOUT 


JSR 

TEST 


MOVE.B 

#0,VECOUT 


JSR 

TEST 


MOVE.B 

#1,VECOUT 


JSR 

TEST 


MOVE.B 

#0,VECOUT 


JSR 

TEST 


MOVE.B 

#1,VECOUT 


MOVE.W 

#256,DO 


MOVE.B 

#255,RED 


MOVE.B 

#255,GREEN 


MOVE.B 

#255,BLUE 


HICOLOR: 

JSR 

COLOUT 


SUB. W 

#1, DO 


BNE 

HICOLOR 


MOVE.L 

#LOGDATA,AO 


MOVE.L 

#0,D7 


LOGLOAD: 

MOVE.L 

#1133,DO 


JSR 

STUFFDO 


MOVE. B 

#$1C,MATHCMD 


MOVE.L 

D7, DO 


JSR 

STUFFDO 


MOVE. B 

#$1C,MATHCMD 


MOVE. B 

#$08,MATHCMD 


MOVE. B 

#$12,MATHCMD 


MOVE.B 

#$IE,MATHCMD 


JSR 

YANKDO 


MOVE.W 

DO,(AO)+ 


ADD. L 

#1,D7 


CMP. L 

#4096,D7 


BNE 

LOGLOAD 


MOVE.W 

#400,CUSVALL 


MOVE.W 

# 528,CUSVALR 


MOVE.W 

#464,CUSVALH 


MOVE.W 

#271,CUSVALV 


MOVE.W 

#464,CUSVH 


MOVE.W 

#271, CUSW 
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MOVE.L 

#FCB1,AO 

ADD. L 

#8, AO 

MOVE.B 

#'0\(AO) 

ADD. L 

#4,AO 

MOVE.B 

#24,DO 

FCBZO: 

MOVE.B 

#0,(AO)+ 

SUB. B 

# 1 1 DO 

BNE 

FCBZO 

* JSR 

RESTORE 

MOVE.L 

#PAGE1,A1 

MOVE.L 

#PAGE3,A4 

MOVE.L 

#$19300,DO 

DRKLOAD: 

MOVE.W 

(Al)+,(A4) + 

SUB. L 

#1,D0 

BNE 

DRKLOAD 

MOVE.L 

#FCB1, AO 

ADD. L 

#8, AO 

MOVE.B 

#'1\ (AO) 

ADD. L 

#4,AO 

MOVE.B 

#24,DO 

FCBZ1: 

MOVE.B 

#0,(AO) + 

SUB. B 

# 1 / DO 

BNE “ 

FCBZ1 

* JSR 

RESTORE 

MOVE.L 

#PAGE1,A1 

MOVE•L 

#PAGE4,A4 

MOVE.L 

#$19300,DO 

FLTLOAD: 

MOVE.W 

(Al)+,(A4)+ 

SUB. L 

# 1 / DO 

BNE 

FLTLOAD 

TOP: 

JSR 

SCREEN 

JSR 

TESTIN 

CLR. L 

DO 

MOVE.B 

SYSIO,DO 

JSR 

TESTOUT 

MOVE.B 

DO,SYSIO 

CMP. B 

#'0 *,DO 

BNE 

PG1 

JSR 

AUTOMODE 

PG1: 

CMP. B 

# * 1•,DO 

BNE 

PG2 

JSR 

MANMODE 

PG2: 

CMP. B 

# 1 2 *,DO 

BNE 

PG3 

JSR 

TIMING 

PG3: 

CMP. B 

# 1 3•,DO 

BNE 

PG4 

JSR 

EXPCON 

PG4: 

CMP. B 

#'Q',DO 

BEQ 

ALLDONE 

BRA 

TOP 

ALLDONE: 

MOVE.L 

#ENDMSG,Al 

JSR 

MSGOUT 


RTS *TO CP/M 
********* 

* SUBROUTINE EXPCON FOR SETTING EXPOSURE TIME 

EXPCON: 

MOVEM.L D0-D4/A0,-(A7) 

TRYAGAIN: 

MOVE.B # *0*,EXPTIME1 

MOVE.B # 'O',EXPTIME2 

MOVE.B # 'O',EXPTIME3 

MOVE.B # ' 1 * ,EXPTIME4 

MOVE.L #EXPMSG,A1 

JSR MSGOUT 

JSR INNOTIME 

CLR DO 

MOVE.B SYSIO,DO 

JSR TESTOUT 

CMP.B #»0',D0 

BLT TRYAGAIN 

CMP.B # 1 9',DO 
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BGT 

MOVE.B 
MOVE.B 
JSR 
MOVE.B 
JSR 
CMP. B 
BLT 
CMP. B 
BGT 

MOVE.B 
MOVE.B 
JSR 
MOVE.B 
JSR 
CMP. B 
BLT 
CMP. B 
BGT 

MOVE.B 
MOVE.B 
JSR 
MOVE.B 
JSR 
CMP. B 
BLT 
CMP. B 
BGT 

MOVE.B 
MOVE.B 
EXPOUT: 
CLR.L 
MOVE.B 
SUB. B 
CLR.L 
MOVE.B 
SUB. B 
MULU 
ADD. W 
CLR.L 
MOVE.B 
SUB. B 
MULU 
ADD. W 
CLR.L 
MOVE.B 
SUB. B 
MULU 
ADD. W 
CMP. W 
BNE 

MOVE.W 
EXPDONE: 
MOVE.W 
MOVEM.L 
RTS 

********* 

* 

TIMING: 
MOVEM.L 
JSR 
CLR.L 
MOVE.B 
JSR 
MOVE.B 
SUB. B 
LSL.B 
MOVE.B 
JSR 
CLR.L 
MOVE.B 
JSR 
MOVE.B 
SUB. B 
LSL.B 
MOVE.B 
JSR 
CLR.L 
MOVE.B 
JSR 
MOVE.B 
SUB. B 
LSL.B 


TRYAGAIN 
DO,SYS10 
DO,EXPTIME1 
INNOTIME 
SYSIO,DO 
TESTOUT 
#* 0•,DO 
TRYAGAIN 
#'9 »,DO 
TRYAGAIN 
DO,SYSIO 
DO,EXPTIME2 
INNOTIME 
SYSIO,DO 
TESTOUT 
#'0•,DO 
TRYAGAIN 
# 1 9•,DO 
TRYAGAIN 
DO,SYSIO 
DO,EXPTIME3 
INNOTIME 
SYSIO,DO 
TESTOUT 
#'0•,DO 
TRYAGAIN 

# * 9 •,DO 
TRYAGAIN 
DO,SYSIO 

DO,EXPTIME4 

D1 

EXPTIME4,D1 
#$30,D1 
DO 

EXPTIME3,DO 
#$30,DO 
#10,DO 
DO, D1 
DO 

EXPTIME2,DO 
#$30,DO 
#100,DO 
DO, D1 
DO 

EXPTIME1,DO 
#$30,DO 
#1000,DO 
DO, D1 
#0, D1 
EXPDONE 

# 1 1 D1 

Dl,EXPOSURE 
(A7)+,D0-D4/A0 


SUBROUTINE TIMING FOR SETTING CCD PULSES 

D0-D4/A0,-(A7) 

TESTIN 

DO 

SYSIO,DO 
TESTOUT 
DO,SYSIO 
#$30,DO 
II, DO 

DO,HORTIME 

TESTIN 

DO 

SYSIO,DO 
TESTOUT 
DO,SYSIO 
#$30,DO 
#3,DO 

DO,VERTIME 

TESTIN 

DO 

SYSIO,DO 
TESTOUT 
DO,SYSIO 
#$30,DO 
#3, DO 
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MOVE.B DO,ADTIME 
MOVEM.L (A7)+,D0-D4/A0 
RTS 

********* 

MANMODE: 


MOVEM.L 

D0-D7/A0-A6,-(A7) 

JSR 

MANSCR 

MCOMAND: 

MOVE.L 

#RDYMSG2,A1 

JSR 

ACKMSG 

JSR 

TESTIN 

CLR.L 

DO 

MOVE.B 

SYSIO,DO 

CMP. B 

#'0 *,DO 

BNE 

MJ1 

MOVE.L 

#ACKMSG20,A1 

JSR 

ACKMSG 

JSR 

RCA IN 

MJ1: 

CMP. B 

# 1 1 1 ,DO 

BNE 

MJ2 

MOVE•L 

#ACKMSG21,A1 

JSR 

ACKMSG 

JSR 

PTOS 

MJ2: 

CMP. B 

r 2',DO 

BNE 

MJ3 

MOVE.L 

#ACKMSG22,A1 

JSR 

ACKMSG 

JSR 

AVERAGE 

MJ3: 

CMP. B 

# 1 3•,DO 

BNE 

MJ4 

MOVE.L 

#ACKMSG23,A1 

JSR 

ACKMSG 

JSR 

PIXELFIX 

&J4: 

CMP. B 

#'4•,DO 

BNE 

MJ5 

MOVE.L 

#ACKMSG24,A1 

JSR 

ACKMSG 

JSR 

COLOR 

MJ5: 

CMP. B 

# ' 5 • , DO 

BNE 

MJ6 

MOVE.L 

#ACKMSG25,A1 

JSR 

ACKMSG 

JSR 

BIGSHOW 

MJ6: 

CMP. B 

#•6•,DO 

BNE 

MJ7 

MOVE.L 

#ACKMSG26,A1 

JSR 

ACKMSG 

JSR 

LOG 

MJ7: 

CMP. B 

#*7\DO 

BNE 

SJ1 

MOVE.L 

#ACKMSG27,A1 

JSR 

ACKMSG 

MOVE.B 

#1,PAGE 

MOVE.W 

# BASECOL1,X 

JSR 

SHOW 

SJ1: 

CMP. B 

#'8',DO 

BNE 

SJ2 

MOVE.L 

#ACKMSG28,A1 

JSR 

ACKMSG 

MOVE.B 

#2,PAGE 

MOVE.W 

#BASECOL2,X 

JSR 

SHOW 

SJ2: 

CMP. B 

*'9•,DO 

BNE 

MJ8 

MOVE.L 

#ACKMSG29,A1 

JSR 

ACKMSG 

JSR 

GROUPS 

MJ8: 

CMP. B 

# ' A ' , DO 

BNE 

MJ9 

MOVE•L 

#ACKMSG2A,A1 

JSR 

ACKMSG 

JSR 

MAGNIFY 

MJ9: 

CMP. B 

§ ' B' , DO 

BNE 

MJ10 

MOVE.L 

#ACKMSG2B,A1 
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JSR 

ACKMSG 

JSR 

TESTOUT 

MOVE.B 

$1A,SYSIO 

JSR 

REPORT 

JSR 

MANSCR 

MJ10: 

CMP. B 

#»C\DO 

DNE 

MJ11 

MOVE.L 

#ACKMSG3C,A1 

JSR 

ACKMSG 

JSR 

FILEPICK 

JSR 

SAVE 

MJ11: 

CMP. B 

# * D' , DO 

BNE 

SJ3 

MOVE.L 

#ACKMSG2D,A1 

JSR 

ACKMSG 

JSR 

SCRNVAL 

SJ3: 

CMP. B 

# ' E * , DO 

BNE 

SJ4 

MOVE.L 

#ACKMSG2E,A1 

JSR 

ACKMSG 

JSR 

WHIRL 

SJ4: 

CMP. B 

# * F * , DO 

BNE 

MJ12 

MOVE.L 

#ACKMSG3F,A1 

JSR 

ACKMSG 

JSR 

FILEPICK 

JSR 

RESTORE 

MJ12: 

CMP. B 

#'G*,DO 

BNE 

MJ13 

MOVE.L 

#ACKMSG2G,A1 

JSR 

ACKMSG 

JSR 

DRKFIELD 

MJ13: 

CMP. B 

# * H •, DO 

BNE 

MJ14 

MOVE.L 

#ACKMSG2H,A1 

JSR 

ACKMSG 

JSR 

SUBSTOP 

MJ14: 

CMP. B 

#'I',DO 

BNE 

MJ15 

MOVE.L 

#ACKMSG2I,A1 

JSR 

ACKMSG 

JSR 

FLTFIELD 

MJ15: 

CMP. B 

#'J\DO 

BNE 

MJ16 

MOVE.L 

#ACKMSG2J,A1 

JSR 

ACKMSG 

JSR 

BIAS 

MJ16: 

CMP. B 

#'K\DO 

BNE 

MJ17 

MOVE.L 

#ACKMSG2K,A1 

JSR 

ACKMSG 

JSR 

HISTCURS 

MJ17: 

CMP. B 

# ' L* , DO 

BNE 

MJ18 

MOVE. L 

jlf ACKMSG2L, A1 

JSR 

ACKMSG 

JSR 

SCRNCUR 

MJ18: 

CMP. B 

# ' M ' , DO 

BNE 

MJ19 

MOVE.L 

#ACKMSG2M,A1 

ASL.L 

#1,D0 

ADD. L 

DO , A1 

CLR.L 

DO 

MOVE.W 

(Al),DO 

JSR 

DIGITS4 

RTS 

CDONE: 

MOVE.W 

CUSVALH,DO 

MOVE.W 

CUSVH,D3 

MOVE.W 

D3,CUSVALH 

MOVE.W 

DO,CUSVH 

MOVE.W 

D3, D1 

MOVE.W 

CUSVALV,DO 
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HmVI- W CUSW, D3 

m i W D3,CUSVALV 

n. .VI W DO,CUSW 

MOVI.W D3,D2 

JSR CB 

JSR TEST 

MOVE.B # ' B * ,VECOUT *ENABLE ALL BIT PLANES 

JSR TEST 

MOVE.B # $ FF,VECOUT 

JSR TEST 

MOVE.B #$1,VECOUT 

MOVEM.L (A7)+,D0-D7/A0-A1 

RTS 

********* 

VECMSG: 


MOVE.L 

DO,-(A7) 

MOVE.W 

#255,DO 

JSR 

C 

JSR 

TEST 

MOVE.B 

# ' R',VECOUT 

JSR 

TEST 

MOVE.B 

# 1 A*,VECOUT 

MOVE.W 

#600,X 

MOVE.W 

#110,Y 

JSR 

M 

JSR 

TEST 

MOVE.B 

#'$',VECOUT 

JSR 

TEST 

MOVE.B 

#•X•,VECOUT 

JSR 

TEST 

MOVE.B 

#$0D,VECOUT 

MOVE.W 

#600,X 

MOVE.W 

#70,Y 

JSR 

M 

JSR 

TEST 

MOVE.B 

# 1 $•,VECOUT 

JSR 

TEST 

MOVE.B 

# , Y',VECOUT 

JSR 

TEST 

MOVE. B 

#$0D,VECOUT 

MOVE.W 

#600,X 

MOVE.W 

#220,Y 

JSR 

TEST 

MOVE. B 

#'J»,VECOUT 

JSR 

TEST 

MOVE.B 

# *M',VECOUT 

JSR 

TEST 

MOVE.B 

# $1C,MATHCMD 

MOVE.B 

# $17,MATHCMD 

MOVE.B 

#$12,MATHCMD 

CLR.L 

DO 

CLR.L 

D1 

MOVE.W 

CUSVALH,DO 

MOVE.W 

CUSVH,D1 

CMP. W 

01, DO 

BGT 

LSE2 

EXG 

LSE2: 

Dl, DO 

SUB. L 

01,00 

MULU 

#39,DO 

JSR 

STUFFDO 

MOVE.B 

#$1C,MATHCMD 

MOVE.B 

#$17,MATHCMD 

MOVE.B 

#$12,MATHCMD 

MOVE.B 

#$10,MATHCMD 

MOVE.B 

#$01,MATHCMD 

MOVE.L 

#5,DO 

JSR 

STUFFDO 

MOVE.B 

#$1C,MATHCMD 

MOVE.B 

#$10,MATHCMD 

MOVE.L 

#10,DO 

JSR 

STUFFDO 

MOVE.B 

#$1C,MATHCMD 

MOVE.B 

#$13,MATHCMD 

MOVE.B 

#$IE,MATHCMD 

MOVEM.L 

(A7)+,D0-D2 

MOVE.W 

#255,DO 

JSR 

C 

MOVE.W 

#600,X 

MOVE.W 

#190,Y 

CLR.L 

DO 

JSR 

YANKDO 

AND. L 

#$OOOOFFFF,DO 

JSR 

DIGITS4 

MOVE.W 

#600,X 

MOVE.W 

#90,Y 
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CLR.L 

DO 

MOVE.W 

D1, DO 

SUB. W 

#335,DO 

JSR 

DIGITS4 

MOVE.W 

#600,X 

MOVE.W 

#50,Y 

CLR.L 

DO 

MOVE.W 

D2 , DO 

SUB. W 

#69,DO 

JSR 

DIGITS4 

MOVE.W 

#600,X 

MOVE.W 

#390,Y 

MOVE.L 

#PAGE2,A1 

CLR.L 

DO 

MOVE.W 

CUSVALV,DO 

SUB. L 

#70,DO 

MULU 

#256,DO 

CLR.L 

D4 

MOVE.W 

CUSVALH,D4 

ADD. L 

D4 , DO 

SUB. L 

#336,DO 

BRA 

KEYBDIN 

CW: 

MOVE.W 

#511,DO 

JSR 

C 

BRA 

CVAL 

CB: 

MOVE.W 

#0, DO 

JSR 

C 

CVAL: 

SUB. W 

#4 , D1 

MOVE.W 

D1, X 

MOVE.W 

D2,Y 

JSR 

M 

ADD. W 

#8,D1 

MOVE.W 

D1, X 

MOVE.W 

D2,Y 

JSR 

L 

SUB. W 

#4 , D1 

SUB. W 

#4,D2 

MOVE.W 

D1, X 

MOVE.W 

D2, Y 

JSR 

M 

ADD. W 

#8, D2 

MOVE.W 

D1, X 

MOVE.W 

D2,Y 

JSR 

L 

SUB. W 

#4,D2 

MOVE.W 

D1,D7 

SUB. W 

#272,D7 

SUB. W 

#4 , D7 

MOVE.W 

D7, X 

MOVE.W 

D2,Y 

JSR 

M 

ADD. W 

#8 , D7 

MOVE.W 

D7, X 

MOVE.W 

D2, Y 

JSR 

L 

SUB. W 

#4,D7 

SUB. W 

#4 , D2 

MOVE.W 

D7, X 

MOVE.W 

D2,Y 

JSR 

M 

ADD. W 

#8, D2 

MOVE.W 

D7, X 

MOVE. W 

D2, Y 

JSR 

L 

SUB. W 

#4 , D2 

LETSSEE: 

MOVEM.L 

D0-D2,-(A7) 

CLR.L 

DO 

CLR.L 

D1 

MOVE.W 

CUSVALV,DO 

MOVE. W 

CUSVV,D1 

CMP. W 

D1, DO 

BGT 

LSE1 

EXG 

D1, DO 

LSE1: 

SUB. L 

D1, DO 

MULU 

#31,DO 

JSR 

STUFFDO 

JSR 

CB 

MOVE.B 

SYSIO,DO 
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CMP. D 

#$08,DO 

★LEFT ARROW ? 

BEQ 

CLEFT 


CMP.B 

#$0C,DO 

★RIGHT ARROW ? 

BEQ 

CRIGHT 


CMP.B 

#$0B,DO 

★LEFT ARROW ? 

BEQ 

CUP 


CMP.B 

#$16,DO 

★RIGHT ARROW ? 

BEQ 

CDOWN 


CMP.B 

#$0D,DO 

★CARRIGE RETURN ? 

BEQ 

CDONE 


CMP.B 

# ' L' , DO 


BNE 

OTHER 


JSR 

CW 


JSR 

GRAPH 


BRA 

KEYBDIN 


OTHER: 

CMP.B 

#' *,DO 


BNE 

KEYBDIN 


JSR 

CW 


MOVE.W 

CUSVALH,DO 


MOVE.W 

CUSVH,D3 


MOVE.W 

D3,CUSVALH 


MOVE.W 

DO,CUSVH 


MOVE.W 

D3,D1 


MOVE.W 

CUSVALV,DO 


MOVE.W 

CUSW, D3 


MOVE.W 

D3,CUSVALV 


MOVE.W 

DO, CUSW 


MOVE.W 

D3,D2 


BRA 

KEYBDIN 


CRIGHT: 

CMP. W 

#591,D1 


BGT 

KEYBDIN 


ADD. W 

#1,D1 


MOVE.W 

D1,CUSVALH 


JSR 

LETSSEE 


BRA 

KEYBDIN 


CLEFT: 

CMP. W 

#337,D1 


BLT 

KEYBDIN 


SUB. W 

#1,D1 


MOVE.W 

Dl,CUSVALH 


JSR 

LETSSEE 


BRA 

KEYBDIN 


CUP: 

CMP. W 

#472,D2 


BGT 

KEYBDIN 


ADD. W 

# 1, D2 


MOVE.W 

D2,CUSVALV 


JSR 

LETSSEE 


BRA 

KEYBDIN 


CDOWN: 

CMP. W 

#71,D2 


BLT 

KEYBDIN 


SUB. W 

#1,D2 


MOVE.W 

D2,CUSVALV 


JSR 

LETSSEE 


CMP. W 

D1,D2 


BGT 

NOSWITCH 


EXG 

D1,D2 


40SWITCH: 

SUB. W 

D1,D2 


CMP. W 

#200,D2 


BGT 

ENUF 


MOVE.W 

#0,(A1)+ 


SUB. L 

#1,D0 


BNE 

DIFFER1 


BRA 

DIFFOUT 


ENUF: 

SUB.L 

#2, A2 


MOVE.W 

(A2)+,D2 


MOVE.W 

D2,(Al)+ 


SUB.L 

# 1 / DO 


BNE 

DIFFER1 


DIFFOUT: 

MOVEM.L 

(A7)+,DO-D3/AO-A3 

RTS 

********* 

SUBCONST: 

MOVEM.L 

D0-D3/A0-A2, 

>-(A7) 

MOVE.L 

#PAGE1,A1 


MOVE•L 

#PAGE2,A2 


MOVE.L 

#$19300,DO 


MOVE.W 

CUSVALL,D3 
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SUB. W 
ASL.W 
SUBC1: 
MOVE.W 
SUB. W 
CMP. W 
BGT 

MOVE.W 
SUBC2: 
MOVE.W 
SUB. L 
BNE 

MOVEM.L 

RTS 

********* 


SCRNCUR: 
MOVEM.L 
MOVE.W 
MOVE.W 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
JSR 

KEYBDIN: 
JSR 

KEYWAIT: 
BTST 
BEQ 
MULU 
ADD. L 
MOVE.W 
SUB. L 
BNE 
DIVU 
AND. L 
DIVU 
AND. L 
MOVE.L 
JSR 
MOVE.B 
MOVE.B 
MOVE.B 
JSR 

MOVE.L 
MOVE.L 
MEANRES: 
MOVE•W 
SUB. L 
BNE 

MOVE•L 
DEVRES: 
MOVE.W 
SUB. L 
BNE 

MOVEM.L 

RTS 

********* 
ADCONST: 
MOVEM.L 
MOVE•L 
MOVE.L 
MOVE•L 
MOVE.W 
SUB. W 
ASL.W 
ADDC1: 
MOVE.W 
ADD. W 
CMP. W 
BLT 

MOVE.W 
ADDC2: 
MOVE.W 
SUB. L 
BNE 

MOVEM.L 

RTS 

********* 


#337,D3 
#4,D3 

(A2)+,D1 
D3,D1 
#0, D1 
SUBC2 
#0,D1 

Dl,(Al) + 

#1,D0 

SUBC1 

(A7)+ ,D0-D3/A0-A2 


SCRNCUR 

D0-D7/A0-A1,-(A7) 

CUSVALH,Dl 
CUSVALV,D2 
TEST 

# ' B' ,VECOUT *ENABLE ONLY 9th BIT PLANE 

TEST 

#0,VECOUT 
TEST 

#1,VECOUT 

VECMSG 

LETSSEE 

CW 

#1,SYSST 
KEYWAIT 
D3,D2 
D2,D4 
D3 , (Al) + 

#1,D0 
DELTAP2 
#7936,D4 
#$0000FFFF,D4 
#13,D4 

#$0000FFFF,D4 
D4, DO 
STUFFDO 

# $1C,MATHCMD 
#$01,MATHCMD 
#$IE,MATHCMD 
YANKDO 
#PAGE1,Al 
#2560,D3 

Dl,(Al)+ 

# 1 / D3 
MEANRES 
#2560,D3 

DO,(Al)+ 

#1,D3 

DEVRES 

(A7)+,D0-D4/A0-A2 


D0-D3/A0-A2,-(A7) 
#PAGE1,Al 
#PAGE2,A2 
#$19300,DO 
CUSVALL,D3 
#337,D3 
#4 , D3 

(A2)+,Dl 
D3,D1 
#4095,Dl 
ADDC2 
#4095,Dl 

Dl,(Al)+ 

#1,D0 

ADDC1 

(A7)+,DO-D3/AO-A2 
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DIFFER: 

MOVEM.L 

DO-D3/AO-A3,-(A7) 

MOVE.L 

#PAGE1,A1 

MOVE.L 

#PAGE2,A2 

MOVE.L 

#$19300,DO 

DIFFER1: 

CLR.L 

D1 

CLR.L 

D2 

MOVE.W 

(A2) +, D2 

MOVE.W 

(A1),D1 

JSR 

RCA IN 

JSR 

MAKEDARK 

MOVE. L 

#1, D1 

MOVE. L 

#2, D2 

VUTOIN: 

JSR 

RCAIN 

MOVE.L 

#PAGE3,A3 

MOVE.L 

#PAGE1,A1 

MOVE.L 

#$19300,DO 

\UTOLOPl: 

CLR.L 

D3 

CLR.L 

D4 

MOVE.W 

(A3),D3 

MULU 

D1,D3 

MOVE.W 

(Al),D4 

ADD. L 

D4,D3 

DIVU 

D2,D3 

MOVE.W 

D3,(A3)+ 

MOVE.W 

D3,(Al)+ 

SUB. L 

#1,D0 

BNE 

AUTOLOP1 

ADD. L 

#1 # D1 

ADD. L 

#1 # D2 

CMP. L 

#10,D1 

BNE 

AUTOIN 

AUTOOUT: 

MOVEM.L 

(A7)+,D0-D7/A0-A6 

RTS 

********* 

STATS: 

MOVEM.L 

D0-D4/A0-A2,-(A7) 

MOVE.L 

#PAGE2,A2 

MOVE.L 

#$19300,DO 

CLR.L 

D1 

CLR.L 

D2 

SUMP2: 

MOVE.W 

(A2)+,D2 

ADD. L 

D2,D1 

SUB. L 

# 1, DO 

BNE 

SUMP2 

DIVU 

#7936,D1 

AND. L 

#$0000FFFF,D1 

DIVU 

#13,D1 

AND. L 

#$0000FFFF,D1 

MOVE.L 

# PAGE1,Al 

MOVE.L 

# PAGE2,A2 

MOVE.L 

#$19300,DO 

CLR.L 

D2 

CLR.L 

D3 

CLR.L 

D4 

DELTAP2: 

CLR.L 

D2 

MOVE.W 

(A2) +, D2 

MOVE.W 

D1,D3 

CMP 

D3,D2 

BGT 

GOON 

EXG 

D3,D2 

GOON: 

SUB. W 

D3,D2 

MOVE.W 

D2,D3 

JSR 

ACKMSG 

* JSR 

BLACKOUT 

MJ19: 

CMP. B 

#'N',DO 

BNE 

MJ20 

JSR 

NEGATIVE 

MJ20: 

CMP. B 

# 'O' , DO 

BNE 

MJ21 

JSR 

ADCONST 

MJ21: 

CMP. B 

#*P*,D0 

BNE 

MJ22 

JSR 

SUBCONST 
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MJ22: 


CMP. B 

#'R',DO 

BNE 

MJ23 

JSR 

MAKEDARK 

MJ23: 

CMP. B 

#'S»,D0 

BNE 

MJ24 

JSR 

MAKEFLAT 

MJ24: 

CMP. B 

# ' T' , DO 

BNE 

MJ25 

JSR 

STAR0UT5 

MJ25: 

CMP. B 

#'U',D0 

BNE 

MJ26 

JSR 

THREED 

MJ26: 

CMP. B 

#'V',D0 

BNE 

MJ27 

JSR 

HIGHPASS 

MJ27: 

CMP. B 

#'W ,D0 

BNE 

MJ28 

JSR 

MAPMAKER 

MJ28: 

CMP. B 

#*X',D0 

BNE 

MJ29 

JSR 

STAROUT 

MJ29: 

CMP. B 

# ’ Y \ DO 

BNE 

MJ30 

JSR 

STATS 

MJ30: 

CMP. B 

# ' Z * , DO 

BNE 

MJ36 

JSR 

DIFFER 

MJ36: 

CMP. B 

# ' Q' , DO 

BEQ 

MANOUT 

BRA 

MCOMAND 

MANOUT: 

MOVEM.L 

(A7)+ , D0-D7/A0-A6 

RTS *TO TOP 

********* 

AUTOMODE: 

MOVEM.L 

D0-D7/A0-A6,-(A7) 

MOVE.B 

#1,VECOUT 

JSR 

M 

JSR 

TEST 

MOVE.B 

#'$*,VECOUT 

JSR 

TEST 

MOVE.B 

#'S',VECOUT 

JSR 

TEST 

MOVE.B 

#'e',VECOUT 

JSR 

TEST 

MOVE.B 

#»p',VECOUT 

JSR 

TEST 

MOVE.B 

# ' a ' ,VECOUT 

JSR 

TEST 

MOVE.B 

# ' r 1 ,VECOUT 

JSR 

TEST 

MOVE.B 

#'a',VECOUT 

JSR 

TEST 

MOVE.B 

#'t•,VECOUT 

JSR 

TEST 

MOVE.B 

#»i',VECOUT 

JSR 

TEST 

MOVE.B 

#'O',VECOUT 

JSR 

TEST 

MOVE.B 

#’n»,VECOUT 

JSR 

TEST 

MOVE.B 

#$0D,VECOUT 

MOVE.W 

#600,X 

MOVE.W 

#210,Y 

JSR 

M 

JSR 

TEST 

MOVE.B 

#'$',VECOUT 

JSR 

TEST 

MOVE.B 

#»i\ VECOUT 

JSR 

TEST 

MOVE.B 

#'n•,VECOUT 

JSR 

TEST 

MOVE.B 

#• *,VECOUT 

JSR 

TEST 
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MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 

JSR 
MOVE.B 
MOVE.W 
MOVE.W 
JSR 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
MOVE.W 
MOVE. W 
JSR 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
MOVE.W 
MOVE.W 
JSR 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 

MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
MOVE.L 
RTS 

********* 

* 

* 

DIGITS4: 
MOVEM.L 
MOVE.L 
MOVE.W 
JSR 
JSR 


#'a*,VECOUT 
TEST 

#'r*,VECOUT 
TEST 

# , c»,VECOUT 
TEST 

#' ',VECOUT 

TEST 

#■ 

•",VECOUT 
TEST 

#$0D,VECOUT 
#600,X 
#430,Y 
M 

TEST 

#•$•,VECOUT 
TEST 

#'1»,VECOUT 
TEST 

# • 2 » ,VECOUT 
TEST 

#' *,VECOUT 

TEST 

# 'B',VECOUT 
TEST 

#•i # ,VECOUT 
TEST 

#•t•,VECOUT 
TEST 

#$0D,VECOUT 
#600,X 
#420,Y 
M 

TEST 

#•$»,VECOUT 
TEST 

#'P»,VECOUT 
TEST 

# *i 1 ,VECOUT 
TEST 

#'X*,VECOUT 
TEST 

#'e',VECOUT 
TEST 

#'1»,VECOUT 
TEST 

#$0D,VECOUT 
#600,X 
#410,Y 
M 

TEST 

#•$»,VECOUT 
TEST 

#'V',VECOUT 
TEST 

#'a',VECOUT 
TEST 

# 1 1•,VECOUT 
TEST 

I'll*, VECOUT 
TEST 

#'e»,VECOUT 
TEST 

#$0D,VECOUT 
TEST 

#'R*,VECOUT 
TEST 

#'E',VECOUT 
TEST 

#'J',VECOUT 
TEST 

#'M *,VECOUT 
TEST 

#2,VECOUT 
(A7)+,DO 


SUBROUTINE FOURDIG 

WRITES VALUE OF DO TO VECTRIX SCREEN IN UP TO FOUR DECIMAL DIGITS 


D0-D1/A0,-(A7) 
DO, D1 
#511,DO 
C 

TEST 
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MOVE.B 
JSR 
MOVE.B 
JSR 
JSR 
MOVE.B 
MOVE.L 
JSR 
JSR 

MOVE. L 
ADD. L 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 

MOVE.B 
JSR 
MOVE.B 
MOVEM.L 
RTS 

********* 

* 

* 

GRAPH: 
MOVEM.L 
MOVE.L 
MOVE.L 
BLANKP1: 
MOVE.W 
SUB. L 
BNE 

MOVE.L 
MOVE.L 
CLR.L 
MOVE.W 
SUB. W 
LSL.W 
ADD. L 
MOVE.W 
GRAPH1: 
MOVE.L 
CLR.L 
MOVE.W 
LSR.W 
LSL.W 
ADD. L 
MOVE.W 
ADD. L 
ADD. L 
SUB. W 
BNE 

MOVE.B 
MOVE.W 
JSR 

MOVEM.L 

RTS 

********* 

★ 

C: 

JSR 
MOVE.B 
JSR 
MOVE.B 
ROR.W 
JSR 
MOVE.B 
ROL.W 
RTS 

********* 

* 

* 

L: 

MOVE.L 
JSR 
MOVE.B 
MOVE.W 
JSR 


#'R*,VECOUT 
TEST 

#'A 1 ,VECOUT 
M 

TEST 

# '$' ,VECOUT 
D1, DO 
STASHDO 
KRUNCH 

#DECIMAL,AO 
#6,AO 
TEST 

(AO)+,VECOUT 
TEST 

(AO)+,VECOUT 
TEST 

(AO)+,VECOUT 
TEST 

(AO),VECOUT 
TEST 

#$OD,VECOUT 
TEST 

# 'R*,VECOUT 
TEST 

#'E',VECOUT 
(A7)+,DO-D1/AO 


SUBROUTINE GRAPH: 

PLOTS GRAPH OF PIXEL VALUES ON Y AXIS OF CURSOR 

D0-D4/A0-A3,-(A7) 

#PAGE1,A1 
#$19300,DO 

#0,(Al)+ 

#1,D0 

BLANKP1 

# PAGE2,A2 

# PAGE1,A3 
D4 

CUSVALH,D4 
#336,D4 
#1,D4 
D4,A2 
#403,DO 

A3, Al 
D1 

(A2),D1 
#4,D1 

# 1, D1 
D1,A1 
#4095,(Al) 

#512,A2 
#512,A3 

# 1 # DO 
GRAPH1 

#1,PAGE 
#BASEC0L1,X 
SHOW 

(A7 )+,D0-D4/A0-A3 


VECTRIX COLOR COMMAND 

TEST *WAIT FOR EMPTY TRANSMIT BUFFER 

# *C*,VECOUT **C» - VECTRIX COLOR COMMAND 

TEST 

DO,VECOUT 
#8, DO 
TEST 

DO,VECOUT 
#8,DO 


VECTRIX LINE COMMAND 
USES X,Y 

DO,-(A7) 

TEST 

#'L*,VECOUT 
X, DO 
TEST 
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MOVE.B 
ROR.W 
JSR 
MOVE.B 
MOVE.W 
JSR 
MOVE. B 
ROR.W 
JSR 
MOVE.B 
MOVE. L 
RTS 

********* 

LOG: 

MOVEM.L 
MOVE. L 
MOVE.L 
MOVE.L 
MOVE.L 
LOGLOOP: 
MOVE. W 
LSL.W 
MOVE.W 
MOVE. W 
SUB. L 
BNE 

MOVEM.L 
RTS 

********* 
FILEPICK: 
MOVEM.L 
MOVE.L 
ADD. L 
RANGE: 
.JSR 
CLR.L 
MOVE.B 
CMP. B 
BLT 
CMP. B 
BLE 
CMP. B 
BLT 
CMP. B 
BLE 
BRA 

INRANGE: 
JSR 
MOVE. B 
MOVE. B 
ADD. L 
MOVE.B 
FCBZERO: 
MOVE.B 
SUB. B 
BNE 

MOVEM.L 
RTS 

********* 


RESTORE: 
MOVEM. L 
MOVE. W 
MOVE.L 
TRAP 
MOVE.L 
MOVE.B 
MOVE.W 
MOVE.L 
TRAP 
MOVE.L 
MOVE.W 
NFCB: 
MOVE.L 
MOVE.B 
MOVE.W 
MOVE.L 
TRAP 
NBYTE: 
CLR.L 
MOVE.B 
MOVE.B 
SUB. B 
BNE 
SUB. W 


DO,VECOUT 
#8, DO 
TEST 

DO,VECOUT 
Y, DO 
TEST 

DO,VECOUT 
#8, DO 
TEST 

DO,VECOUT 
(A7) +, DO 


DO-D2/AO-A2,-(A7) 
#PAGE1,A1 
ft PAGE2 , A2 
#LOGDATA,AO 
#$19300,DO 

(A2)+,D1 

#1,D1 

0 (AO, Dl) ,D2 
D2,(Al)+ 
ft 1, DO 
LOGLOOP 

(A7)+,D0-D2/A0-A2 


DO/AO,-(A7) 
#FCB1,AO 
#8,AO 

INNOTIME 

DO 

SYSIO,DO 
#'0',DO 
RANGE 
#•9',DO 
INRANGE 

# ' A' , DO 
RANGE 

# 1 Z ' , DO 
INRANGE 
RANGE 

TESTOUT 
DO,SYSIO 
DO,(AO) 
ft 4,AO 
#24,DO 

#0,(AO)+ 

# 1 / DO 
FCBZERO 
(A7)+,DO/AO 


RESTORE SUBPROGRAM 

RESTORE THE IMAGE ON DISK TO PAGE1 


D0-D3/A0-A1, 

#$0F,DO 
#FCB1,Dl 
#2 

# FCB1,AO 
#0,32 (AO)" 

# $1A,DO 
#DMA,Dl 
#2 

#PAGEl,AO 
#1612,D2 

#DMA,Al 
#128,D3 

#$14,DO ♦CP/M BDOS READ SEQUENTIAL FUNCTION 

#FCB1,Dl 

#2 ♦READ NEXT 128 BYTE BLOCK TO DISK 

Dl 

( Al) -f, Dl 
Dl,(AO)+ 

# 1 r D3 
NBYTE 

# 1, D2 


“ (A7) 

♦CP/M BDOS OPEN FILE FUNCTION 
♦OPEN OLD IMAGE FILE 

♦CP/M BDOS SET DMA FUNCTION 
♦DIRECT DATA TO THIS DMA BUFFER 
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BNE 

MOVE.W 
MOVE.L 
TRAP 
MOVE.W 
MOVE.W 
TRAP 
MOVEM.L 
SAVEDONE: 
RTS 

********** 

* 

MAKEDARK: 
MOVEM.L 
MOVE.L 
MOVE.L 
MOVE.L 
MD1: 

MOVE.W 
SUB. L 
BNE 

MOVEM.L 

RTS 

********* 

* 

* 

P2T01: 
MOVEM.L 
MOVE.L 
MOVE.L 
MOVE•L 
P2T01L0: 
MOVE.W 
SUB. L 
BNE 

MOVEM.L 

RTS 

******** 

* 

MAKEFLAT: 
MOVEM.L 
MOVE.L 
MOVE.L 
MOVE.L 
MF1: 

MOVE.W 

SUB.L 

BNE 

MOVEM.L 

RTS 

********* 

* 

* 

DRKFIELD: 
MOVEM.L 
MOVE.L 
MOVE.L 
MOVE.L 
MOVE.L 
DFIELDO: 
MOVE.W 
MOVE.W 
CMP. W 
BEQ 
SUB. W 
BCC 

MOVE.W 
DFIELD1: 
MOVE.W 
SUB.L 
BNE 

MOVEM.L 

RTS 

********* 

* 

* 

FLTFIELD: 
MOVEM.L 
CLR.L 
CLR.L 
MOVE.L 
ADD. L 
MOVE.L 
CLR.L 


NFCB 

#$10,DO *CP/M BDOS CLOSE FILE FUNCTION 

#FCB1,D1 

#2 

#$25,DO *CP/M BDOS RESET DRIVE FUNCTION 

#2, D1 

#2 

(A7)+,D0-D3/A0-A1 


SUBROUTINE MAKEDARK 

D0-D3/A0-A3,-(A7) 
#PAGE3,A3 
#PAGE1,A1 
#$19300,DO 

(Al)+,(A3)+ 

#1 , DO 
MD1 

(A7)+,D0-D3/A0-A3 


SUBROUTINE P2T01 
MOVE PAGE2 TO PAGE1 

D0-D3/A0-A3,—(A7) 
#PAGE2,A2 
#PAGE1,A1 
#$19300,DO 

(A2)+,(Al)+ 

# 1, DO 
P2T01L0 

(A7)+,DO-D3/AO-A3 


SUBROUTINE MAKEFLAT 

D0-D3/A0-A3,-(A7) 
#PAGE4,A3 

# PAGE1,Al 
#$19300,DO 

(Al)+,(A3)+ 

# 1 / DO 
MD1 

(A7)+,D0-D3/A0-A3 


SUBROUTINE DRKFIELD 

SUBTRACTS DARKFIELD FROM STAR IMAGE 

D0-D3/A0-A3,-(A7) 

#PAGE3,A3 
# PAGE2,A2 
#PAGE1,Al 
#$19300,DO 

(A2)+,D2 
(A3)+,D3 
#4095,D2 
DFIELD1 
D3,D2 
DFIELD1 
#0, D2 

D2,(Al)+ 

#1,D0 

DFIELDO 

(A7)+,D0-D3/A0-A3 


SUBROUTINE FLTFIELD 

PUTS TEMPLAT AND RESULT IN PAGE 1 

D0-D5/A0-A4,-(A7) 

D1 

D2 

#PAGE4,AO 
#$19300,AO 
#$C980,DO 
D5 
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FFO: 

MOVE.W 
ADD. L 
SUB. L 
BNE 
DIVU 
AND. L 
DIVU 
AND. L 
MOVE.L 
MOVE.L 
MOVE.L 
MOVE.L 
MOVE.L 
FF1: 

CLR.L 
MOVE.W 
ROL.L 
CMP. W 
BEQ 
DIVU 
ZEROO: 
CLR.L 
MOVE.W 
CMP. W 
BEQ 
ROL.L 
CMP. W 
BEQ 
DIVU 
ZEROl: 
MOVE.W 
SUB. L 
BNE 

MOVEM.L 

RTS 

********* 

* 

* 

SAVE: 
MOVEM.L 
MOVE.W 
MOVE.L 
TRAP 
MOVE.W 
MOVE.L 
TRAP 
MOVE.W 
MOVE.L 
TRAP 
MOVE.L 
MOVE.W 
NEXTFCB: 
MOVE.L 
MOVE.B 
NEXTBYTE: 
MOVE.B 
SUB. B 
BNE 

MOVE.W 
MOVE. L 
TRAP 
SUB. W 
BNE 

MOVE. W 
MOVE. L 
TRAP 
MOVE. W 
MOVE.W 
TRAP 
MOVEM.L 
RTS 

********* 

* 

* 

WHIRL: 

MOVEM.L 
WLOOP1: 
MOVE.L 
MOVE.L 
ADDA.L 
MOVE.B 
MOVE.B 
MOVE.B 
MOVE.L 
MOVE.L 


(AO)+ ,D5 
D5, D1 
#1,D0 
FFO 

#1664,D1 
#$OOOOFFFF,D1 
#31,D1 

#$OOOOFFFF,D1 
#PAGE4,A4 
#PAGE2,A2 
#PAGE1,A1 
#$19300,DO 
#12,D3 

D2 

(A4 ) + , D2 
D3,D2 
#0, D1 
ZEROO 
D1,D2 

D4 

(A2)+,D4 

#4095,D4 

ZEROl 

D3,D4 

#0, D2 

ZEROl 

D2,D4 

D4,(Al)+ 

# 1, DO 
FF1 

(A7)+,D0-D5/A0-A4 


SAVE SUBPROGRAM 

SAVE THE IMAGE IN PAGE1 TO DISK 


D0-D3/A0-A1,-(A7) 


#$13,DO 
# FCB1,D1 
#2 

#$16,DO 
#FCB1,D1 
#2 

#$1A,DO 
#DMA,D1 
#2 

#PAGE1,AO 
#1612,D2 

#DMA,Al 
#128,D3 


(AO)+,(Al)+ 

#1,D3 
NEXTBYTE 
#$15,DO 
#FCB1,D1 
#2 

# 1, D2 
NEXTFCB 
#$10,DO 
#FCB1,D1 
#2 

#$25,DO 
#2, D1 
#2 

(A7)+,D0-D3/A0-A1 


♦CP/M BDOS DELETE FILE FUNCTION 


♦ERASE ANY OLD FILE BY THIS NAME 
♦CP/M BDOS MAKE FILE FUNCTION 


♦CREATE A NEW IMAGE FILE 
♦CP/M BDOS SET DMA FUNCTION 


♦DIRECT DATA TO THIS DMA BUFFER 


♦CP/M BDOS WRITE SEQUENTIAL FUNCTION 
♦WRITE NEXT 128 BYTE BLOCK TO DISK 

♦CP/M BDOS CLOSE FILE FUNCTION 

♦CP/M BDOS RESET DRIVE FUNCTION 


SUBPROGRAM WHIRL 

SPINS COLORS IN WCOLOR THROUGH THE VECTRIX LOOKUP TABLE 

D0-D3/A0-A1,-(A7) 

#WCOLORS,AO 
#WCOLORS,Al 
#765,Al 
(AO)+,(Al)+ 

(AO)+,(Al)+ 

(AO)+,(Al)+ 

#WCOLORS,AO 
#WCOLORS,Al 
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ADDA.L 
MOVE.W 
WLOOP3: 
MOVE. B 
SUB. W 
BNE 

MOVE.B 
JSR 
MOVE.B 
JSR 

MOVE. B 
JSR 

MOVE. B 
JSR 
MOVE.B 
JSR 
MOVE.B 
MOVE. L 
WLOOP2: 
MOVE. B 
MOVE. B 
MOVE.B 
JSR 
SUB. B 
BNE 
BTST 
BNE 
BRA 
WDONE: 
MOVEM.L 
RTS 

********* 

* 

* 

GROUPS: 
MOVEM.L 
JSR 

MOVE.L 
MOVE.L 
BOTOUT: 
MOVE.W 
SUB. L 
BNE 
CLR.L 
CLR.L 
CLR.L 
MOVE.L 
ADD. L 
MOVE.L 
SUB. L 
AVGBASE: 
MOVE.W 
ADD. L 
SUB. L 
BNE 
JSR 
MOVE.B 
MOVE.L 
JSR 
MOVE.B 
MOVE.B 
MOVE.B 
JSR 
MOVE.W 
LSR.W 
ADD. W 
CLR.L 
MOVE.L 
MOVE.L 
MOVE.L 
FINDGPS: 
MOVE.W 
CMP. W 
BGT 

MOVE.W 
BRA 
KEEP: 

MOVE.W 
OUT 2: 

MOVE.W 
SUB. L 
BNE 

MOVE.L 
MOVE.L 


#3,A1 
#765,DO 

(A1) +,(AO)+ 

#1,D0 
WLOOP3 
#255,DO 
TEST 

# * Q *,VECOUT 
TEST 

#1,VECOUT 
TEST 

#0,VECOUT 
TEST 

#255,VECOUT 
TEST 

#0,VECOUT 
#WCOLORS,AO 

(AO)+,RED 
(AO)+,GREEN 
(AO)+,BLUE 
COLOUT 
#1,D0 
WLOOP2 

# 1,SYSST 
WDONE 
WLOOP1 

(A7) +,D0-D3/A0-A1 


GROUPS WILL FIND AND CHARACTERIZE GROUPS OF PIXELS 
LOOKING AT 403 LINES OF 256 PIXELS EACH 

D0-D7/A0-A6,-(A7) 

GPINIT 
#PAGE2,AO 
#8192,D3 

#0,(AO)+ 

# 1 # D3 
BOTOUT 
DO 

D1 

D2 

# PAGE2,AO 
#16384,AO 
#$19300,D3 
#8192,D3 

(AO)+,D2 
D2, DO 
#1,D3 
AVGBASE 
STUFFDO 

# $1C,MATHCMD 
#103168,DO 
STUFFDO 

#$1C,MATHCMD 
#$13,MATHCMD 
#$IE,MATHCMD 
YANKDO 
DO, D2 

# 1 * DO 
DO, D2 
D1 

#PAGE1,A1 

# PAGE2,AO 
#$19300,DO 

(AO)+,D1 
D2,D1 

KEEP *THIS IS THE CUTOFF DETERMINATION 

#0, D1 

OUT2 

#1,D1 

D1,(A1)+ *PUTS BINARY IMAGE OF PAGE2 INTO PAGE1 

#1,D0 

FINDGPS 

#$19301,DO 

#PAGE1,AO 
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IDOKNXT: 


mm.L 

#1 , DO 


GPDONE 

MOVE.W 

(AO)+,D1 

CMP.W 

#1 / D1 

BNE 

LOOKNXT 

MOVE.L 

AO, Al 

SUBA.L 

#4 , A1 

CLR.L 

D1 

CLR.L 

D2 

CLR.L 

D3 

CLR.L 

D4 

MOVE.W 

(A1),D1 

SUBA.L 

#512,A1 

MOVE. W 

(A1)+,D2 

MOVE.W 

(Al)+ , D3 

MOVE.W 

(A1),D4 

CLR.L 

D5 

CMP.W 

D1,D2 

BGT 

GPOl 

EXG 

D1,D2 

GPOl: 

CMP.W 

D2,D3 

BGT 

GP02 

EXG 

D2,D3 

GP02: 

CMP.W 

D3,D4 

BGT 

GP03 

EXG 

D3,D4 

GP03: 

CMP.W 

D1,D2 

BGT 

GP04 

EXG 

D1,D2 

GP04: 

CMP.W 

D2,D3 

BGT 

GP05 

EXG 

D2,D3 

GP05: 

CMP.W 

D1,D2 

BGT 

GP06 

EXG 

D1,D2 

GP06: 

CMP.W 

#0, D4 

BEQ 

NEWGROUP 

CMP.W 

#0, D1 

BEQ 

GPOA 

CMP.W 

D1,D4 

BEQ 

OLDGROUP 

BRA 

CONFLICT 

GPOA: 

CMP.W 

#0, D2 

BEQ 

GPOB 

CMP.W 

D2,D4 

BEQ 

OLDGROUP 

BRA 

CONFLICT 

GPOB: 

CMP.W 

#0,D3 

BEQ 

GPOC 

CMP.W 

D3,D4 

GPOC: 

BEQ 

OLDGROUP 

BRA 

CONFLICT 

* ASSIGN A NEV 

NEWGROUP: 

MOVE.L 

#AREA,A1 

MOVE•L 

A1,D1 

ADD. L 

#4, Al 

ADD. L 

#$4000,D3 

NOTEMPTY: 

CMP. L 

Al, D1 

BEQ 

FULL 

MOVE.L 

(Al)+,D2 

BNE 

NOTEMPTY 

SUB. L 

#4, Al 

MOVE•L 

#1,(Al) 

MOVE.L 

Al, D1 

SUB. L 

#AREA,D1 

LSR.L 

#2, D1 

MOVE. L 

AO, Al 

SUB. L 

#2, Al 

MOVE.W 

Dl,(Al) 

MOVE. L 

A1,D2 

SUB. L 

#PAGE1,D2 

MOVE.L 

# PAGE2,Al 

ADD. L 

A1,D2 

MOVE. L 

D2,A1 


GROUP NUMBER TO THIS PIXEL 


*D1 NOW POINTS TO THE END OF 'AREA* 


*A1 POINTS TO AN EMPTY SPOT IN 'AREA' 


*D1 NOW HOLDS GROUP NUMBER 


*PUT GROUP NUMBER BACK IN HIGH BINARY IMAGE 
*D2 NOW HOLDS OFFSET TO PAGE2 
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CLR.L 
MOVE.W 
MOVE.L 
LSL.L 
MOVE.L 
LSR.L 
MOVE. L 
SUB. L 
SUB. L 
DIVU 
MOVE.L 
MOVE.W 
MOVE.L 
MOVE.W 
MOVE.L 
SWAP 
LSR.W 
MOVE.W 
MOVE.L 
MOVE.W 
BRA 


OLDGROUP: 
MOVE.L 
SUB. L 
MOVE. L 
MOVE. W 
SUB. L 
ADD. L 
MOVE.L 
CLR.L 
MOVE. W 
LSL.L 
MOVE.L 
ADD. L 
MOVE.L 
MOVE. L 
ADD. L 
MOVE.L 
LSR.L 
MOVE. L 
SUB. L 
SUB. L 
DIVU 
MOVE.L 
MOVE.W 
SWAP 
LSR.W 
MOVE.L 
MOVE.W 
CMP. W 
BGT 

MOVE.W 

OLD1: 

MOVE.L 
MOVE.W 
CMP. W 
BLT 

MOVE.W 

OLD2: 

BRA 

CONFLICT: 
CMP. W 
BNE 
EXG 
CMP. W 
BNE 
EXG 

LINKUP: 
LSL.W 
LSL.W 
MOVE.L 
MOVE.L 
MOVE.L 
ADD. L 
MOVE.L 
MOVE.L 
MOVE.L 
ADD. L 
LSR.W 
LSR.W 
MOVE•L 
MOVE•L 
MOVE.L 


D3 

(A1),D3 
#BRIGHT,A1 
#2, D1 

D3,0(A1,D1) 

#1,D1 

AO, D3 

#2,D3 

# PAGE1,D3 

#512,D3 

#VMAX,A1 

D3,0(A1,D1) 

#VMIN,A1 

D3,0(A1,Dl) 

#HMAX,A1 

D3 

#1,D3 

D3,0(A1,D1) 

#HMIN,A1 

D3,0(A1,D1) 

LOOKNXT 


♦MULTIPLY BY 4 FOR LONGWORD TRANSFER 
♦FILLS GROUPth LOCATION IN BRIGHTNESS TABLE 
♦DIVIDE BY 2 FOR WORD TRANSFER 


♦TRANSFER VMAX 
♦TRANSFER VMIN 

♦REMAINDER AFTER DIV. = HORIZ. POSITION 
♦TRANSFER HMAX 
♦TRANSFER HMIN 


♦PUT GROUP# IN THIS LOCATION OF PAGE1 


AO, Dl 
#2, Dl 
D1,A1 
D4,(Al) 

#PAGE1,Dl 
#PAGE2,Dl 
Dl, Al 
Dl 

(A1),D1 

#2,D4 ♦MULTIPLY BY FOUR FOR LONGWORD TRANSFER 
#BRIGHT,Al 

Dl,0(Al,D4) *UPDATE INTEGRATED BRIGHTNESS FOR GROUP 
#AREA,Al 
0(Al,D4),Dl 
#1,D1 

Dl,0(Al,D4) 

#1 / D4 
AO, Dl 
#2, Dl 
#PAGE1,Dl 
#512,Dl 
#VMAX,Al 
Dl,0(Al,D4) 

Dl 

#1 / Dl 
#HMAX,Al 
0(Al,D4),D2 
D1,D2 
OLD1 

Dl,0(Al,D4) 


♦DIVIDE BY 2 FOR WORD TRANSFER 


♦VMIN WAS TAKEN CARE OF WHEN GROUP EST. 

♦WE GO UP, THIS V >= OLD V, SO JUST FILL IN 
♦THIS LEAVES HORIZONTAL POS. IN LOW WORD 


#HMIN,Al 
0(Al,D4),D2 
D1,D2 
OLD2 

Dl,0(Al,D4) 


LOOKNXT 


#0, Dl 

LINKUP 

D1,D2 

#0, Dl 

LINKUP 

D1,D3 


#2, Dl 
#2, D4 
#AREA,Al 
0(Al,D4),D2 
#0,0(Al,D4) 
D2,0 (Al, Dl) 
#BRIGHT,Al 
0(Al,D4),D2 
#0,0(Al,D4) 
D2,0 (Al, Dl) 
#1,D1 
#1,D4 
#VMAX,Al 
0(Al,Dl),D2 
0(Al,D4),D3 


♦MULTIPLY BY FOUR FOR LONGWORD TRANSFER 


♦DIVIDE BY TWO FOR WORD TRANSFERS 
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MOVE.L #0,0(A1,D4) 

CMP. L D2 , D3 

BGT LINK1 

EXG D2, D3 

LINK1: 

MOVE.L D3,0(A1,D1) 

MOVE.L #HMAX,A1 

MOVE.L 0(A1,Dl),D2 

MOVE.L 0(A1,D4),D3 

MOVE.L #0,0(A1,D4) 

CMP.L D2,D3 

BGT LINK2 

EXG D2, D3 

LINK2: 

MOVE.L D3,0(A1,Dl) 

MOVE.L #VMIN,A1 

MOVE.L 0(A1, Dl), D2 

MOVE.L 0(A1,D4),D3 

MOVE.L #$1FF,0(A1,D4) 

CMP.L D2,D3 

BLT LINK3 

EXG D2, D3 

LINK3: 

MOVE.L D3,0(A1,Dl) 

MOVE.L #HMIN,A1 

MOVE.L 0(A1,D1),D2 

MOVE.L 0(A1,D4),D3 

MOVE.L #$FF,0(A1,D4) 

CMP. L D2 , D3 

BLT LINK4 

EXG D2 , D3 

LINK4: 

MOVE.L D3,0(A1,Dl) 

EXG D1,D4 *PUT GROUP NUMBER WHERE OLDGROUP CAN FIND IT 

LSR.L #1,D4 *AND MAKE IT THE RIGHT SIZE 

BRA OLDGROUP 

FULL: 

MOVE.L #ERRMSG,A1 

JSR MSGOUT 

MOVEM.L (A7)+,D0-D7/A0-A6 

RTS 


GPDONE: 

MOVE.L #$19300,DO 
MOVE.L #PAGE1,AO 

MULTPAG1: 

MOVE.W (AO),Dl 

LSL.W #4,Dl 

MOVE.W Dl,(AO)+ 

SUB.L #1,DO 

BNE MULTPAG1 

MOVEM.L (A7)+ ,D0-D7/A0-A6 

RTS 

********* 


GPINIT SUBROUTINE 

THIS INITIALIZES H&V MAX&MIN, BRIGHT, AND AREA FOR GROUPS PROGRAM 


GPINIT: 
MOVE.L 
MOVE.L 
GPLOOP2 
CLR.W 
DBF 


#256,DO 
#HMAX,AO 


(AO) + 

DO,GPLOOP2 

♦ VERTICAL MAX INIT 
MOVE.L #256,DO 

MOVE.L #VMAX,AO 
GPLOOP3: 

CLR.W (AO) 4* 

DBF DO,GPLOOP3 

♦ HORIZONTAL MIN INIT 
MOVE.L #256,DO 

MOVE.L #HMIN,AO 
GPLOOP4: 

MOVE.W 
DBF 


#$100,(AO)+ 

DO,GPLOOP4 
VERTICAL MIN INIT 
MOVE.L #256,DO 
#VMIN,AO 


MOVE.L 
GPLOOP5: 
MOVE.W 
DBF 


#$1FF,(AO)+ 
DO,GPL00P5 
♦ BRIGHTNESS INIT 

MOVE.L #256,DO 

MOVE.L #BRIGHT,AO 

GPL00P6: 

CLR.L (AO)+ 


♦SET INITIAL HMAXs TO 0 


♦SET INITIAL VMAXs TO 0 


♦LARGER THAN ANY REAL HMIN 


♦LARGER THAN ANY REAL VMIN 
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DBF DO,GPLOOP6 

* AREA INIT 

MOVE.L #256,DO 
#AREA,AO 


MOVE.L 
GPLOOP7 
CLR.L 
DBF 


(AO) + 

DO,GPLOOP7 


RTS *TO GROUPS 
********* 


* 

HISTCURS 


★ 

HISTOGRAM CURSOR 

HISTCURS: 

MOVEM.L 

D0-D6/A0-A1, 

“ (A7) 

MOVE.W 

CUSVALR,D1 


MOVE.W 

CUSVALL,D2 


KEYINH: 

JSR 

HCWHITE 


JSR 

HCBLACK 


BTST 

#1,SYSST 

★KEY PRESSED? 

BEQ 

KEYINH 


MOVE.B 

SYSIO,DO 


CMP. B 

#$08,DO 

★LEFT ARROW ? 

BEQ 

RLEFT 


CMP. B 

#$0C,DO 

★RIGHT ARROW ? 

BEQ 

RRIGHT 


CMP. B 

#$0B,DO 

★UP ARROW ? 

BEQ 

LRIGHT 


CMP. B 

#$16,DO 

★DOWN ARROW ? 

BEQ 

LLEFT 


CMP. B 

#$0D,DO 

★CARRIGE RETURN 

BEQ 

STRETCH 


BRA 

KEYINH 


RRIGHT: 

CMP.W 

#590,D1 


BGT 

KEYINH 


ADD. W 

#1,01 


MOVE.W 

Dl,CUSVALR 


BRA 

KEYINH 


RLEFT: 

CMP.W 

D2,D1 


BEQ 

LLEFT 


SUB. W 

#1,D1 


MOVE.W 

Dl,CUSVALR 


BRA 

KEYINH 


LRIGHT: 

CMP.W 

D2,D1 


BEQ 

RRIGHT 


ADD. W 

#1,D2 


MOVE.W 

D2,CUSVALL 


BRA 

KEYINH 


LLEFT: 

CMP.W 

#337,D2 


BLT 

KEYINH 


SUB. W 

#1,D2 


MOVE.W 

D2,CUSVALL 


BRA 

KEYINH 


HCWHITE: 

JSR 

TEST 


MOVE.B 

#'C',VECOUT 


JSR 

TEST 


MOVE.B 

#$FF,VECOUT 


JSR 

TEST 


MOVE.B 

#0,VECOUT 


BRA 

CURSOUT 


HCBLACK: 

JSR 

TEST 


MOVE.B 

#'C',VECOUT 


JSR 

TEST 


MOVE.B 

#0,VECOUT 


JSR 

TEST 


MOVE.B 

#0,VECOUT 


CURSOUT: 

JSR 

TEST 


MOVE•B 

#'M',VECOUT 


JSR 

TEST 


MOVE.B 

Dl,VECOUT 


ROR.W 

#8, Dl 


JSR 

TEST 


MOVE.B 

Dl,VECOUT 


ROL.W 

#8, Dl 


JSR 

TEST 


MOVE.B 

#0,VECOUT 


JSR 

TEST 


MOVE.B 

#0,VECOUT 
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JSR 

TEST 

MOVE.B 

# ' L*,VECOUT 

JSR 

TEST 

MOVE.B 

Dl,VECOUT 

ROR.W 

#8,D1 

JSR 

TEST 

MOVE.B 

Dl,VECOUT 

ROL.W 

#8,D1 

JSR 

TEST 

MOVE.B 

#3,VECOUT 

JSR 

TEST 

MOVE.B 

#0,VECOUT 

JSR 

TEST 

MOVE.B 

# ' M *,VECOUT 

JSR 

TEST 

MOVE.B 

D2,VECOUT 

ROR.W 

#8, D2 

JSR 

TEST 

MOVE. B 

D2,VECOUT 

ROL.W 

#8, D2 

JSR 

TEST 

MOVE.B 

#0,VECOUT 

JSR 

TEST 

MOVE.B 

#0,VECOUT 

JSR 

TEST 

MOVE. B 

#»L',VECOUT 

JSR 

TEST 

MOVE.B 

D2,VECOUT 

ROR.W 

#8,D2 

JSR 

TEST 

MOVE. B 

D2,VECOUT 

ROL.W 

#8,D2 

JSR 

TEST 

MOVE.B 

#3,VECOUT 

JSR 

TEST 

MOVE.B 

#0,VECOUT 

RTS 

STRETCH: 

MOVE.L 

#$19300,DO 

MOVE. L 

#PAGE2,AO 

MOVE.L 

#PAGE1,A1 

SUB.W 

#336,Dl 

SUB. W 

#336,D2 

LSL.W 

#4, Dl 

LSL.W 

#4,D2 

STALOOP: 

CLR.L 

D3 

MOVE.W 

(AO)+,D3 

CMP. W 

D2,D3 

BGT 

STA1 

MOVE.W 

#0, D3 

BRA 

STAOUT 

STA1: 

CMP. W 

D1,D3 

BLT 

STA2 

MOVE.W 

#4095,D3 

BRA 

STAOUT 

STA2 : 

MOVE.W 

D2,D4 

MOVE.W 

Dl, D5 

SUB.W 

D4,D3 

SUB.W 

D4,D5 

MULU 

#4095,D3 

DIVU 

D5,D3 

STAOUT: 

MOVE.W 

D3, (Al) + 

SUB. L 

# 1, DO 

BNE 

STALOOP 

CURSDONE: 

MOVEM.L 

RTS 

(A7)+,D0-D6/A0-A1 

********* 


* 

SCRNVAL 

SCRNVAL: 

MOVEM.L 

D0-D7/A0,-(A7) 

MOVE.L 

#WCOLORS,AO 

MOVE.W 

CUSVALR,Dl 

MOVE.W 

CUSVALL,D2 

JSR 

LETSEE 

KEYINS: 

JSR 

VALWHITE 

JSR 

VALBLACK 

BTST 

#1,SYSST 

BEQ 

KEYINS 

JSR 

NOSEE 

MOVE.B 

SYSIO,DO 
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CMP. B 

#$08,DO 

BEQ 

LLEFTS 

CMP. B 

#$0C,DO 

BEQ 

LRIGHTS 

CMP. B 

#$0D,DO 

BEQ 

VALDONE 

BRA 

KEYINS 

RRIGHTS: 

CMP. W 

#590,D1 

BGT 

KEYINS 

ADD. W 

# 1 / D1 

MOVE.W 

D1,CUSVALR 

JSR 

LETSEE 

BRA 

KEYINS 

LRIGHTS: 

CMP. W 

D1,D2 

BEQ 

RRIGHTS 

ADD. W 

#1,D2 

MOVE.W 

D2,CUSVALL 

JSR 

LETSEE 

BRA 

KEYINS 

LLEFTS: 

CMP. W 

#337,D2 

BLT 

KEYINS 

SUB. W 

# 1, D2 

MOVE.W 

D2,CUSVALL 

JSR 

LETSEE 

BRA 

KEYINS 

VALWHITE: 

JSR 

TEST 

MOVE.B 

#•C•,VECOUT 

JSR 

TEST 

MOVE.B 

#$FF,VECOUT 

JSR 

TEST 

MOVE.B 

#0,VECOUT 

BRA 

CURSVAL 

VALBLACK: 

JSR 

TEST 

MOVE.B 

#'C•,VECOUT 

JSR 

TEST 

MOVE. B 

#0,VECOUT 

JSR 

TEST 

MOVE.B 

#0,VECOUT 

CURSVAL: 

JSR 

TEST 

MOVE.B 

#'M *,VECOUT 

JSR 

TEST 

MOVE.B 

D2,VECOUT 

ROR.W 

#8, D2 

JSR 

TEST 

MOVE.B 

D2,VECOUT 

ROL.W 

#8, D2 

JSR 

TEST 

MOVE.B 

#0,VECOUT 

JSR 

TEST 

MOVE.B 

#0,VECOUT 

JSR 

TEST 

MOVE.B 

#'L*,VECOUT 

JSR 

TEST 

MOVE.B 

D2,VECOUT 

ROR.W 

#8, D2 

JSR 

TEST 

MOVE.B 

D2,VECOUT 

ROL.W 

#8,D2 

JSR 

TEST 

MOVE.B 

#3,VECOUT 

JSR 

TEST 

MOVE.B 

#0,VECOUT 

RTS 

LETSEE: 

MOVE.W 

D2,D3 

CLR.L 

D7 

SUB. W 

#336,D3 

MOVE.W 

D3,D7 

MULU 

#3 , D3 

AND. L 

#$0000FFFF,D3 

MOVE.B 

#0(AO,D3),D4 

MOVE. B 

# 1 (AO, D3) , D5 

MOVE. B 

# 2(AO,D3),D6 

JSR 

TEST 

MOVE.B 

#'Q',VECOUT 

JSR 

TEST 
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MOVE.B 

D7,VECOUT 

JSR 

TEST 

MOVE.B 

#0,VECOUT 

JSR 

TEST 

MOVE.B 

#1,VECOUT 

JSR 

TEST 

MOVE.B 

#0,VECOUT 

MOVE.B 

#255,RED 

MOVE.B 

#0,GREEN 

MOVE.B 

#255,BLUE 

JSR 

COLOUT 

JSR 

TEST 

MOVE.B 

# ' C' ,VECOUT 

JSR 

TEST 

MOVE.B 

#$FF,VECOUT 

JSR 

TEST 

MOVE.B 

#0,VECOUT 

JSR 

TEST 

MOVE. B 

#'R•,VECOUT 

JSR 

TEST 

MOVE.B 

#'A•,VECOUT 

OUTVAL: 

MOVE.W 

#600,X 

MOVE.W 

#40,Y 

JSR 

TEST 

JSR 

M 

JSR 

TEST 

MOVE.B 

#’$',VECOUT 

OUTVAL1: 

JSR 

TEST 

MOVE.B 

• •,VECOUT 

MOVE.W 

D2,D3 

SUB. W 

#336,D3 

AND. W 

#$00F0,D3 

ROR.W 

#4,D3 

ADD. W 

#$30,D3 

CMP. W 

#$3A,D3 

BLT 

OUTVAL2 

ADD. W 

#7,D3 

OUTVAL2: 

JSR 

TEST 

MOVE.B 

D3,VECOUT 

MOVE.W 

D2,D3 

SUB.W 

#336,D3 

AND. W 

#$OOOF,D3 

ADD. W 

#$30,D3 

CMP. W 

#$3A,D3 

BLT 

OUTVAL3 

ADD. W 

#7,D3 

OUTVAL3: 

JSR 

TEST 

MOVE.B 

D3,VECOUT 

JSR 

TEST 

MOVE.B 

#$0D,VECOUT 

JSR 

TEST 

MOVE.B 

#’R',VECOUT 

JSR 

TEST 

MOVE.B 

#'E',VECOUT 

RTS 

NOSEE: 

CLR.L 

D7 

MOVE.W 

D2,D7 

SUB.W 

#336,D7 

JSR 

TEST 

MOVE.B 

#'Q•,VECOUT 

JSR 

TEST 

MOVE.B 

D7,VECOUT 

JSR 

TEST 

MOVE.B 

#0,VECOUT 

JSR 

TEST 

MOVE.B 

#1,VECOUT 

JSR 

TEST 

MOVE. B 

#0,VECOUT 

MOVE.B 

D4,RED 

MOVE.B 

D5,GREEN 

MOVE.B 

D6,BLUE 

JSR 

COLOUT 

RTS 

VALDONE: 

MOVEM.L 

DT.Q 

(A7)+,D0-D7/A0 

********* 

THREED: 

MOVEM.L 

D0-D4/A0-A3,-(A7) 

MOVE.L 

# PAGE1,A1 

MOVE.L 

#$19300,DO 
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TDO: 

MOVE.W 
SUB. L 
BNE 

MOVE.L 
MOVE.L 
ADD. L 
MOVE.L 
ADD. L 
CLR.L 
MOVE.L 
MOVE.L 
TRELOP1: 
MOVE.L 
MOVE.W 
AND. W 
LSR.W 
ADD. W 
MOVE.L 
TRELOP2: 
MOVE.W 
CMP. W 
BNE 

MOVE.W 
NEXTTP: 
SUB. L 
CMP. L 
BEQ 
ADD. L 
SUB. W 
BNE 

TREROND: 
ADD. L 
ADD. L 
ADD. L 
SUB. L 
BNE 

MOVE.L 
SUB. L 
SUB. L 
SUB. L 
SUB. L 
BNE 

MOVE.L 
MOVE.L 
TD1: 

MOVE.W 
CMP. W 
BNE 

MOVE.W 
TD2: 

MOVE.W 
SUB. L 
BNE 

MOVEM.L 

RTS 

********* 

* 


MAGNIFY: 
MOVEM.L 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 

KEYINM: 

JSR 

JSR 

BTST 

BEQ 

MOVE.B 
CMP. B 
BEQ 
CMP. B 
BEQ 
CMP. B 
BEQ 
CMP. B 
BEQ 
CMP. B 


#$1000,(Al)+ 

#1# DO 

TDO 

#PAGE1,AO 
#PAGE1,A1 
#510,Al 
#PAGE2,A2 
#510,A2 
D1 

#403,D2 
#256,D3 

#0, DO 
(A2),D1 
#$0FFF,D1 
#6,D1 
#1,D1 
Al, A3 

(A3), D4 
#$1000,D4 
NEXTTP 
DO,(A3) 

#2,A3 
A3, AO 
TREROND 
#64,DO 
# 1 1 D1 
TRELOP2 


#512,AO 
#512,Al 
#512,A2 
#1,D2 
TRELOP1 
#403,D2 
#206336,AO 
#206338,Al 
#206338,A2 
#1,D3 
TRELOP1 
#PAGE1,Al 
#$19300,DO 

(A1),D1 
#$1000,D1 
TD2 
#0,D1 

Dl,(Al)+ 

# 1 , DO 
TD1 

(A7)+,DO-D4/AO-A3 


MAGNIFY ROUTINE 

MAGNIFY BY 2 THE IMAGE IN PAGE 2 AND PUTS IT IN PAGE ONE 

D0-D4/A0-A5,-(A7) 

TEST 

#'B',VECOUT 
TEST 

#0,VECOUT 
TEST 

#1,VECOUT 
TESTOUT 

i 

WHITEONE 
BLACKONE 
#1,SYSST 
KEYINM 
SYSIO,DO 
#$08,DO 
LEFT 
#$0C,DO 
RIGHT 
#$0B,DO 
UP 

#$16,DO 
DOWN 
#$0D,DO 
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BEQ 

DOMAG 

BRA 

KEYINM 

RIGHT: 

MOVE.W 

FRAMEX,DO 

CMP. W 

#464,DO 

BGT 

KEYINM 

ADD. W 

#l,DO 

MOVE.W 

DO,FRAMEX 

BRA 

KEYINM 

LEFT: 

MOVE.W 

FRAMEX,DO 

CMP. W 

#336,DO 

BLT 

KEYINM 

SUB. W 

# 1, DO 

MOVE.W 

DO,FRAMEX 

BRA 

KEYINM 

UP: 

MOVE.W 

FRAMEY,DO 

CMP. W 

#271,DO 

BGT 

KEYINM 

ADD. W 

# 1 1 DO 

MOVE.W 

DO,FRAMEY 

BRA 

KEYINM 

DOWN: 

MOVE.W 

FRAMEY,DO 

CMP. W 

#70,DO 

BLT 

KEYINM 

SUB. W 

#1 * DO 

MOVE.W 

DO,FRAMEY 

BRA 

KEYINM 

WHITEONE: 

JSR 

TEST 

MOVE.B 

#'C',VECOUT 

JSR 

TEST 

MOVE. B 

#$FF,VECOUT 

JSR 

TEST 

MOVE.B 

#1,VECOUT 

BRA 

FRAME 

BLACKONE: 

JSR 

TEST 

MOVE.B 

#'C',VECOUT 

JSR 

TEST 

MOVE. B 

#0,VECOUT 

JSR 

TEST 

MOVE. B 

#0,VECOUT 

FRAME: 

MOVE. W 

FRAMEX,DO 

MOVE.W 

FRAMEY, D1 

JSR 

TEST 

MOVE. B 

#'P•,VECOUT 

JSR 

TEST 

MOVE. B 

#$4,VECOUT 

JSR 

TEST 

MOVE.B 

#$0,VECOUT 

JSR 

TEST 

MOVE.B 

DO,VECOUT 

ROR.W 

#8, DO 

JSR 

TEST 

MOVE.B 

DO,VECOUT 

ROL.W 

#8,DO 

JSR 

TEST 

MOVE.B 

Dl,VECOUT 

ROR.W 

#8, D1 

JSR 

TEST 

MOVE.B 

Dl,VECOUT 

ROL.W 

#8, Dl 

ADD. W 

#128,DO 

JSR 

TEST 

MOVE.B 

DO,VECOUT 

ROR.W 

#8,DO 

JSR 

TEST 

MOVE.B 

DO,VECOUT 

ROL.W 

#8,DO 

JSR 

TEST 

MOVE.B 

Dl,VECOUT 

ROR.W 

#8, Dl 

JSR 

TEST 

MOVE.B 

Dl,VECOUT 

ROL.W 

#8, Dl 

ADD. W 

#200,Dl 

JSR 

TEST 

MOVE.B 

DO,VECOUT 

ROR.W 

#8, DO 

JSR 

TEST 

MOVE.B 

DO,VECOUT 

ROL.W 

#8,DO 
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JSR 

TEST 

MOVE.B 

D1,VECOUT 

ROR.W 

#8,D1 

JSR 

TEST 

MOVE.B 

Dl,VECOUT 

ROL.W 

#8,D1 

SUB. W 

#128,DO 

JSR 

TEST 

MOVE.B 

DO,VECOUT 

ROR.W 

#8,DO 

JSR 

TEST 

MOVE.B 

DO,VECOUT 

ROL.W 

#8, DO 

JSR 

TEST 

MOVE.B 

Dl,VECOUT 

ROR.W 

#8, Dl 

JSR 

TEST 

MOVE.B 

Dl,VECOUT 

ROL.W 

#8, Dl 

RTS 

DOMAG: 

CLR.L 

DO 

CLR.L 

Dl 

MOVE.W 

FRAMEY,Dl 

SUB. W 

#69,Dl 

MULU 

#512,Dl 

MOVE.W 

FRAMEX,DO 

SUB. W 

#335,DO 

ROL.W 

#1,D0 

ADD. W 

DO, Dl 

ADD. L 

#PAGE2,Dl 

MOVE.L 

Dl, AO 

MOVE.W 

#200,D3 

MOVE.L 

#PAGE1,DO 

NUTLINE: 

MOVE.L 

DO, A1 

ADD. L 

#512,DO 

MOVE.L 

DO, A2 

ADD. L 

#512,DO 

MOVE.W 

#128,D4 - 

THISLINE: 

MOVE.W 

(AO) +, D2 

MOVE.W 

D2,(Al)+ 

MOVE.W 

D2,(A2)+ 

MOVE.W 

D2,(Al)+ 

MOVE.W 

D2,(A2)+ 

SUB. W 

#1,D4 

BNE 

THISLINE 

ADD. L 

#256,AO 

SUB. W 

#1,D3 

BNE 

NUTLINE 

MAGDONE: 

JSR 

TEST 

MOVE.B 

#'B',VECOUT 

JSR 

TEST 

MOVE.B 

#$FF,VECOUT 

JSR 

TEST 

MOVE.B 

#$1,VECOUT 

MOVEM.L 

(A7)+,D0-D4/A0 

RTS 

********* 

COLOR: 

MOVEM.L 

D0-D2,-(A7) 

COLOOP: 

JSR 

TESTIN 

CLR.L 

DO 

MOVE.B 

SYSIO,DO 

MXC1: 

CMP.B 

# 1 1 *,DO 

BNE 

MXC2 

JSR 

GREY 

MXC2: 

CMP.B 

# ' 2',DO 

BNE 

MXC3 

JSR 

SPECTRUM 

MXC3: 

CMP.B 

#’3',DO 

BNE 

MXC4 

JSR 

CONTOUR 

MXC4: 

CMP.B 

o 

Q 

BNE 

MXC5 

JSR 

WINIT 
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MXC5: 

CMP.B #$0D,DO 

BNE COLOOP 

COLOROUT: 

MOVEM.L (A7)+,D0-D2 

RTS 

********* 

* CONTOUR SUBROUTINE 

GIVES GOOD COLOR VARIATION FOR SMALL CHANGE IN PIXEL VALUE 

CONTOUR: 

MOVEM.L DO/AO,-(A7) 


MOVE.L 

#WCOLORS,AO 

CLR.L 

DO 

MOVE.W 

#16,DO 

NXTCHUNK 

; 

MOVE.B 

#$AA,RED 

MOVE.B 

#0,GREEN 

MOVE.B 

#$55,BLUE 

JSR 

COLFILL 

MOVE.B 

#$AA,RED 

MOVE.B 

#0,GREEN 

MOVE.B 

#0,BLUE 

JSR 

COLFILL 

MOVE.B 

#$FF,RED 

MOVE.B 

#0,GREEN 

MOVE.B 

#0,BLUE 

JSR 

COLFILL 

MOVE.B 

#$FF,RED 

MOVE.B 

#$70,GREEN 

MOVE.B 

#0,BLUE 

JSR 

COLFILL 

MOVE.B 

#$AA,RED 

MOVE.B 

#$70,GREEN 

MOVE.B 

#0,BLUE 

JSR 

COLFILL 

MOVE.B 

#$FF,RED 

MOVE.B 

#$AA,GREEN 

MOVE.B 

#0,BLUE 

JSR 

COLFILL 

MOVE.B 

#$FF,RED 

MOVE. B 

#$FF,GREEN 

MOVE. B 

#0,BLUE 

JSR 

COLFILL 

MOVE. B 

#$AA,RED 

MOVE. B 

#$FF,GREEN 

MOVE. B 

# 0,BLUE 

JSR 

COLFILL 

MOVE.B 

#0,RED 

MOVE. B 

#$AA,GREEN 

MOVE. B 

# 0,BLUE 

JSR 

COLFILL 

MOVE.B 

#0,RED 

MOVE.B 

#$FF,GREEN 

MOVE•B 

# 0,BLUE 

JSR 

COLFILL 

MOVE.B 

#0,RED 

MOVE.B 

#$FF,GREEN 

MOVE.B 

#$AA,BLUE 

JSR 

COLFILL 

MOVE.B 

#0,RED 

MOVE.B 

#$FF,GREEN 

MOVE.B 

#$FF,BLUE 

JSR 

COLFILL 

MOVE.B 

#0,RED 

MOVE.B 

#$AA,GREEN 

MOVE.B 

#$FF,BLUE 

JSR 

COLFILL 

MOVE.B 

#0,RED 

MOVE.B 

#$55,GREEN 

MOVE.B 

#$FF,BLUE 

JSR 

COLFILL 

MOVE.B 

#$AA,RED 

MOVE.B 

#0,GREEN 

MOVE.B 

#$FF,BLUE 

JSR 

COLFILL 

MOVE.B 

#$FF,RED 

MOVE.B 

#0,GREEN 

MOVE.B 

#$FF,BLUE 

JSR 

COLFILL 

SUB. B 

# 1, DO 

BNE 

NXTCHUNK 

MOVE. L 

#WCOLORS,AO 

MOVE. B 

#0,RED 

MOVE.B 

#0,GREEN 

MOVE. B 

#0,BLUE 

JSR 

COLFILL 
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JSR 

MOVEM.L 

RTS 

********* 

* 

WINIT: 
MOVEM.L 
MOVE.L 
MOVE.B 
MOVE.B 
MOVE.B 
JSR 

MOVE.B 
CGRNUP: 
ADD. B 
CMP. B 
BEQ 
JSR 
ADD. B 
BRA 

CTOPGRN: 
MOVE. B 
JSR 

CBLUEUP: 
ADD. B 
CMP. B 
BEQ 
JSR 
ADD. B 
BRA 

CTOPBLUE: 
MOVE. B 
JSR 

CREDUP: 
ADD. B 
CMP. B 
BEQ 
JSR 
ADD. B 
BRA 

CTOPRED: 
MOVE. B 
JSR 

CGREYUP: 
ADD. B 
CMP. B 
BEQ 
JSR 
ADD. B 
ADD. B 
ADD. B 
BRA 

CTOPGREY: 
MOVE.B 
MOVE.B 
MOVE.B 
JSR 
JSR 

MOVEM.L 

RTS 

********* 

* 

SPECTRUM: 
MOVEM.L 
MOVE.L 
MOVE.B 
MOVE.B 
MOVE.B 
JSR 
MOVE.L 
MOVE.B 
RUP1: 

ADD. B 
JSR 
ADD. L 
CMP. L 
BNE 

MOVE.B 
WGRNUP1: 
ADD. B 
SUB. B 
JSR 
ADD. L 


COLSEND 
(A7)+,DO/AO 


WRITES COLOR TO VECTRIX LUT 

D0-D5/A0-A1,-(A7) 

#WCOLORS,AO 
#0,RED 
#0,GREEN 
#0,BLUE 
COLFILL 
#0, DO 

# 1 , DO 
#64,DO 
CTOPGRN 
COLFILL 
#4,GREEN 
CGRNUP 

#$00,GREEN 
COLFILL 

#1,D0 
#128,DO 
CTOPBLUE 
COLFILL 
#4,BLUE 
CBLUEUP 

#$00,BLUE 
COLFILL 

#1,D0 
#192,DO 
CTOPRED 
COLFILL 
#4,RED 
CREDUP 

#$00,RED 
COLFILL 

#1 / DO 
#255,DO 
CTOPGREY 
COLFILL 
#4,RED 
#4,GREEN 
#4,BLUE 
CGREYUP 

#$FF,RED 
#$FF,GREEN 
#$FF,BLUE 
COLFILL 
COLSEND 

(A7)+,D0-D5/A0-A1 


WRITES SPECTRUM SCALE TO THE WCOLOR STORAGE AREA 

DO/AO,-(A7) 

#WCOLORS,AO 

# 0,RED 
#0,GREEN 
#0,BLUE 
COLFILL 
#1,D0 
#127,RED 

#4,RED 
COLFILL 

# 1 , DO 
#33,DO 
RUP1 

#251,RED 

#4,GREEN 
#4,RED 
COLFILL 
#1,D0 
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(’Ml*. I. 
NNK 

YKLL0W1: 
ADI). B 
ADD. B 
JSR 
ADD. L 
CMP. L 
BNE 

MOVE.B 
MOVE.B 
YELLOW2: 
SUB. B 
JSR 
ADD. L 
CMP. L 
BNE 

WBLUEUP: 
ADD. B 
JSR 
ADD. L 
CMP. L 
BNE 

MOVE.B 
BLUEUP2: 
SUB. B 
JSR 
ADD. L 
CMP. L 
BNE 

MOVE.B 
RUP2: 

ADD. B 
SUB. B 
JSR 
ADD. L 
CMP. L 
BNE 

WWHITE: 
MOVE.B 
MOVE.B 
MOVE.B 
JSR 
JSR 

MOVEM.L 

RTS 

********* 

* 


GREY: 
MOVEM.L 
MOVE.L 
CLR.L 
GREYOUT: 
MOVE.B 
MOVE. B 
MOVE. B 
JSR 
ADD. B 
BNE 
JSR 

MOVEM.L 

RTS 

********* 
COLSEND: 
MOVEM.L 
JSR 
MOVE.B 
JSR 

MOVE.B 
JSR 
MOVE.B 
JSR 

MOVE.B 
JSR 
MOVE.B 
MOVE.L 
MOVE.L 
COLSENDO: 
MOVE.B 
MOVE.B 
MOVE.B 
JSR 
SUB. L 
BNE 


#64,DO 
WGRNUP1 

#4,GREEN 
#4,RED 
COLFILL 
#1 / DO 
#96,DO 
YELLOW1 
#255,RED 
#255,GREEN 

#8,RED 
COLFILL 

# 1, DO 
#127,DO 
YELLOW2 

#8,BLUE 
COLFILL 

# 1, DO 
#159,DO 
WBLUEUP 
#255,BLUE 

#5,GREEN 
COLFILL 

# 1 , DO 
#207,DO 
BLUEUP2 
#0,GREEN 

#5,RED 
#3,BLUE 
COLFILL 

# 1, DO 
#255,DO 
RUP2 

#$FF,RED 
#$FF,GREEN 
#$FF,BLUE 
COLFILL 
COLSEND 
(A7)+,DO/AO 


GREY SUBROUTINE 

WRITES GREY SCALE TO THE BOTTOM 256 LOCATIONS IN THE VECTRIX 
COLOR LOOKUP TABLE 

DO/AO,-(A7) 

#WCOLORS,AO 
DO 

DO,RED 
DO,GREEN 
DO,BLUE 
COLFILL 
# 1, DO 
GREYOUT 
COLSEND 
(A7)+,DO/AO 


DO/AO,-(A7) 
TEST 

#'Q',VECOUT 
TEST 

#0,VECOUT 
TEST 

#0,VECOUT 
TEST 

#0,VECOUT 
TEST 

#1,VECOUT 
#256,DO 
#WCOLORS,AO 

(AO)+,RED 
(AO)+,GREEN 
(AO)+,BLUE 
COLOUT 
# 1, DO 
COLSENDO 
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MOVEM.L (A7)+,DO/AO 
RTS 

★******** 


COLOUT: 


BSR 

TEST 

MOVE.B 

RED,VECOUT 

BSR 

TEST 

MOVE. B 

GREEN,VECOUT 

BSR 

TEST 

MOVE.B 

BLUE,VECOUT 

RTS 

********* 

COLFILL: 

MOVE.B 

RED,(AO)+ 

MOVE. B 

GREEN,(AO)+ 

MOVE.B 

PTC 

BLUE,(AO)+ 

********* 

* 

REPLACES BAD PIXELS 

PIXELFIX 

MOVEM.L 

DO-D1/AO,-(A7) 

JSR 

P2T01 

MOVE.L 

#234,DO 

ASL.L 

#5,DO 

ASL.L 

#4, DO 

MOVE.W 

#256,D1 

FIXLINE1: 

JSR 

MEDIANDO 

ADD. L 

#2, DO 

SUB. W 

#1,D1 

BNE 

FIXLINE1 

MOVE.L 

#BADMAP,AO 

READMAP: 

MOVE.L 

(AO)+,DO 

CMP. L 

#$FFFFFFFF,DO 

BEQ 

LASTPIX 

JSR 

MEDIANDO 

BRA 

READMAP 

LASTPIX: 

MOVEM.L 

(A7)+ ,DO-D1/AO 

RTS 

********* 

* 

SUBROUTINE MAPMAKER 

* 

USES PAGE 2 BIT MAP 

MAPMAKER: 

MOVEM.L 

D0-D7/A0-A6,-(A7) 

MOVE. L 

#PAGE2,A2 

MOVE.L 

#BADMAP,AO 

MOVE.L 

#4094,D1 

MOVE. L 

#$19300,DO 

BADLOOP: 

MOVE.L 

A2,A1 

MOVE. W 

(A2)+,D2 

CMP. W 

#4095,D2 

BNE 

BADOVER 

SUB. L 

#PAGE2,A1 

MOVE.L 

Al,(AO)+ 

SUB. L 

#1,D1 

BEQ 

BADDONE 

BADOVER: 

SUB. L 

m,Do 

BNE 

BADLOOP 

BADDONE: 

MOVE.L 

#$FFFFFFFF,(AO) 

MOVEM.L 

(A7)+,D0-D7/A0-A6 

RTS 

********* 

* 

REPLACES PIXEL AT DO 

MEDIANDO: 

MOVEM.L 

D0-D7/A0-A6,-(A7) 

MOVE.L 

#PAGE1,A6 

MOVE.L 

#PAGE2,D2 

ADD. L 

DO, A6 

ADD. L 

DO, D2 

SUB. L 

#2,D2 

SUB. L 

#512,D2 

MOVE.L 

D2, A3 

ADD. L 

#512,D2 

MOVE.L 

D2, A4 

ADD. L 

#512,D2 

MOVE.L 

D2,A5 

MOVE.W (A3)+,D1 

MOVE.W (A3)+,D2 


BAD PIXELS 
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MOVE.W 
MOVE.W 
MOVE.W 
MOVE.W 
MOVE.W 
MOVE.W 
MOVE.W 
MOVE.W 
MOVE.W 
MOVE.B 
EO: 

CMP 

BGT 

EXG 

Els 

CMP 

BGT 

EXG 

E2: 

CMP 

BGT 

EXG 

E3: 

CMP 

BGT 

EXG 

E4: 

CMP 

BGT 

EXG 

E5: 

CMP 
BGT 
EXG 
E6: 

CMP 
BGT 
EXG 
E7: 

CMP 
BGT 
EXG 
E8: 

SUB. B 
BNE 

MOVE.W 

MOVEM.L 

RTS 

********* 

* 

STAROUT5: 
MOVEM.L 
MOVE.L 
MOVE.W 
INITSTAR: 
MOVE.W 
SUB. W 
BNE 

MOVE.L 
MOVE.L 
SUB. L 
MOVE.L 
INITST1: 

MOVE.L 
INITST2: 
MOVE.L 
MOVE.L 
MOVE.W 
ASL.L 
ADD. L 
ADD. W 
SUB. L 
BNE 
ADD. L 
SUB. L 
BNE 


(A3) +, D3 
(A4 ) +, D4 
(A4 ) 4*, D5 
(A4)+,D6 
(A5)+,D7 
D7, AO 
(A5)+,D7 
D7, A1 
(A5)+,D7 
#5,DO 

D1 1 D2 
El 

D1/D2 

D2, D3 
E2 

D2, D3 

D3, D4 
E3 

D3, D4 

D4, D5 
E4 

D4 , D5 

D5, D6 
E5 

D5, D6 

D6, D7 
E6 

D6, D7 

D7, AO 
E7 

D7, AO 

AO, A1 
E8 

A0,A1 

#l,DO 

EO 

D5,(A6) 

(A7)+,D0-D7/A0-A6 


STAROUT 5X5 PIXEL MEDIAN 

D0-D7/A0-A6,-(A7) 
#SORTDATA,A5 
#4096,DO 

#0,(A5)+ 

# 1 , DO 
INITSTAR 

# PAGE2,A2 
#$19300,DO 
#1030,A2 

# 5, D7 

#5,D6 

# SORTDATA,A5 
#0, D1 
(A2)+,D1 
#1,D1 
D1,A5 

#1,(A5) 

# 1 f D6 
INITST2 
#502,A2 
#1,D7 
INITST1 


MOVE.L #SORTDATA,A4 

MOVE.L #0,D3 

MOVE.L #0,D4 

SORTSTA: 

ADD.W (A4)+,D4 
ADD.W #1,D3 

CMP.W #13,D4 

BLT SORTSTA 

SUB.W #1,D3 
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SUB. L 

MOVE.L 
MOVE.L 
SUB. L 
MOVE.L 
SUB. L 
STALOP1: 
MOVE.L 
MOVE.W 
STALOP2: 
MOVE.L 
MOVE.W 
CMP. W 

* BLT 
SUB. W 

STARLOl: 
MOVE.L 
ASL.L 
ADD. L 
SUB. W 
ADD. L 
MOVE.L 
MOVE.W 
CMP. W 
BLT 
ADD. W 
STARL02: 
MOVE.L 
ASL.L 
ADD. L 
ADD. W 
ADD. L 
SUB. W 
BNE 
SUB. L 
SUB. L 
CMP. W 
BEQ 
BGT 
HIGHE: 
ADD. L 
ADD. W 
ADD. W 
CMP. W 
BLT 
BRA 
LOWE: 

SUB. W 
SUB. L 
SUB. W 
CMP. W 
BGT 
ADD. L 
ADD. W 
ADD. W 
FOUN: 

MOVE.L 
SUB. L 
MOVE.L 
LSR.W 
MOVE. W 
SUB. L 
BNE 

MOVEM.L 

RTS 

********* 

* 

STAROUT: 
MOVEM.L 
MOVE. L 
MOVE.W 
INITSTRO: 
MOVE. W 
SUB. W 
BNE 

MOVE.L 
MOVE.L 
SUB. L 
MOVE.L 
INITSTR1: 
MOVE.L 


#2,A4 

#PAGE1,A1 
#PAGE2,A2 
#1030,A2 
#PAGE2,A3 
#1020,A3 

# SORTDATA,A5 
#5, D7 

#0, D1 
(A2),D1 
D1,D3 
STARLOl 
#1,D4 

A5,A6 
#1,D1 
D1,A6 
#1,(A6) 

#512,A2 
#0, D1 
(A3),D1 
D1,D3 
STARL02 
#1,D4 

A5,A6 
#1,D1 
D1,A6 
#1,(A6) 

#512,A3 
#1,D7 
STALOP2 
#2558,A2 
#2558,A3 
#13,D4 
FOUN 
LOWE 

#2,A4 
#1,D3 
(A4),D4 
#13,D4 
HIGHE 
FOUN 

(A4),D4 
#2, A4 

# 1 # D3 

#13,D4 
LOWE 
#2, A4 
#1,D3 
(A4),D4 

A4,A6 
A5,A6 
A6,D1 
#1,D1 
Dl,(Al) + 

#1, DO 
STALOP1 

(A7) +,D0-D7/A0-A6 


STAROUT 15 X 15 PIXEL MEDIAN 

D0-D7/A0-A6,-(A7) 

#SORTDATA,A5 
#4096,DO 

#0,(A5) + 

# 1, DO 
INITSTRO 
#PAGE2,A2 
#$19300,DO 
#3600,A2 
#15,D7 

#15,D6 
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1NITSTR2: 

MOVE.L 

JSORTDATA,A5 

MOVE.L 

#0,D1 

MOVE.W 

(A2)+,D1 

ASL.L 

#1,D1 

ADD. L 

D1,A5 

ADD. W 

#1,(A5) 

SUB. L 

#1,D6 

BNE 

INITSTR2 

ADD. L 

#482,A2 

SUB. L 

# 1, D7 

BNE 

XNITSTR1 

MOVE.L 

#SORTDATA,A4 

MOVE.L 

#0, D3 

MOVE.L 

#0, D4 

SORTSTAR: 

ADD. W 

(A4)+,D4 

ADD. W 

#1,D3 

CMP. W 

#111,D4 

BLT 

SORTSTAR 

SUB. W 

#1, D3 

SUB. L 

#2, A4 

MOVE.L 

#PAGE1,A1 

MOVE•L 

#PAGE2,A2 

SUB. L 

#3600,A2 

MOVE.L 

#PAGE2,A3 

SUB. L 

#3570,A3 

STARLOP1: 

MOVE.L 

# SORTDATA,A5 

MOVE.W 

#15,D7 

STARLOP2: 

MOVE.L 

#0, D1 

MOVE.W 

(A2),D1 

CMP. W 

D1,D3 

BLT 

STLOl 

SUB. W 

#1,D4 

STLOl: 

MOVE.L 

A5,A6 

ASL.L 

# 1, D1 

ADD. L 

D1,A6 

SUB. W 

#1,(A6) 

ADD. L 

#512,A2 

MOVE.L 

#0, D1 

MOVE.W 

(A3),D1 

CMP. W 

D1,D3 

BLT 

STL02 

ADD. W 

#1,D4 

STL02: 

MOVE.L 

A5,A6 

ASL.L 

# 1, D1 

ADD. L 

D1, A6 

ADD. W 

#1,(A6) 

ADD. L 

#512,A3 

SUB. W 

# 1, D7 

BNE 

STARLOP2 

SUB. L 

#7678,A2 

SUB. L 

#7678,A3 

PICKONE: 

CMP. W 

#111,D4 

BEQ 

FOUNDIT 

BGT 

LOWER 

BRA 

HIGHER 

HIGHER: 

ADD. L 

# 2, A4 

ADD. W 

# 1, D3 

ADD. W 

(A4),D4 

CMP. W 

#111,D4 

BLT 

HIGHER 

BRA 

FOUNDIT 

LOWER: 

SUB. W 

(A4) ,D4 

SUB. L 

# 2, A4 

SUB. W 

# 1, D3 

CMP. W 

#111,D4 

BGT 

LOWER 

ADD. L 

#2,A4 

ADD. W 

#1, D3 

ADD. W 

(A4) ,D4 

FOUNDIT: 

MOVE.L 

A4,A6 

SUB. L 

A5,A6 

MOVE.L 

A6,D1 

LSR.W 

#1, D1 

MOVE.W 

Dl,(Al) + 
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SUB. L 

#1,D0 

BNE 

STARLOP1 

MOVEM.I 

DTC 

. (A7) + ,DO—D7/A0-A6 

********* 

AVERAGE: 

MOVEM.L 

D0-D2/A0-A3 ,-( A7 ) 

MOVE.L 

# PAGE2,AO 

SUB. L 

#512,AO 

MOVE.L 

#PAGE2 ,A1 

MOVE.L 

#PAGE2,A2 

ADD. L 

#512,A2 

MOVE.L 

#PAGE1,A3 

MOVE.L 

#$19300,DO 

BIGONE: 

CLR.L 

D1 

CLR.L 

D2 

SUB. L 

#2,AO 

SUB. L 

#2 , A1 

SUB. L 

#2 , A2 

MOVE . W 

(A0)+,D2 

ADD. L 

D2,D1 

MOVE. W 

(A1)+,D2 

ADD. L 

D2,D1 

MOVE . W 

(A2)+,D2 

ADD. L 

D2,D1 

MOVE . W 

(AO) + , D2 

ADD. L 

D2,D1 

MOVE . W 

(A1)+,D2 

ADD. L 

D2,D1 

MOVE . W 

(A2) +, D2 

ADD. L 

D2,D1 

MOVE . W 

(AO),D2 

ADD. L 

D2,D1 

MOVE.W 

(A1),D2 

ADD. L 

D2,D1 

MOVE . W 

(A2),D2 

ADD. L 

D2,D1 

DIVU 

#9 , D1 

MOVE . W 

Dl,(A3 )+ 

SUB. L 

# 1 , DO 

BNE 

BIGONE 

MOVEM.L 

RT.Q 

(A7) + ,DO-D2/AO-A3 

********* 

HIGHPASS: 

MOVEM.L 

D0-D5/A0-A4,-(A7) 

MOVE.L 

# PAGE1,A1 

MOVE.L 

#PAGE2,A2 

MOVE.L 

#$19300,DO 

CLR.L 

Dl 

CLR.L 

D2 

CLR.L 

D3 

CLR.L 

D4 

SUB. L 

#1028,A2 

MOVE.W 

#5, Dl 

PASINIT1: 

MOVE.W 

#5, D2 

PASINIT2: 

MOVE. W 

(A2)+,D4 

ADD. L 

D4,D3 

SUB. W 

#1,02 

BNE 

PAS1NIT2 

ADD. L 

#502,A2 

SUB. L 

# 1, Dl 

BNE 

PASINIT1 

MOVE.L 

#PAGE2,AO 

SUB. L 

#1028,AO 

MOVE.L 

#PAGE2,A1 

SUB. L 

#1020,A1 

MOVE.L 

#PAGE2,A2 

MOVE.L 

#PAGE1,A3 

PASSLOP1: 

MOVE.W 

#5,D1 

ADD. L 

#2,A1 

PASSLOP2: 

CLR.L 

D4 

MOVE.W 

(A1),D4 

ADD. L 

D4,D3 

MOVE.W 

(AO) ,D4 

SUB. L 

D4,D3 

ADD. L 

#512,AO 

ADD. L 

#512,A1 
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SUB* L #1,D1 

BNE PASSL0P2 

ADD.L #2,AO 

SUB.L #2560,AO 

SUB.L #2560,A1 

MOVE.L D3,D4 
DIVU #25,D4 

MOVE.W (A2)+,D5 
LSL.W #1,D5 * 

♦ ADD.W #2047,D5 
SUB.W D4,D5 

CMP.W #0,D5 

BGT TOBIG 

MOVE.W #0,D5 

TOBIG: 

CMP.W #4095,D5 

BLT RIGHTON 

MOVE.W #4095,D5 

RIGHTON: 

MOVE.W D5,(A3)+ 

SUB.L #1,DO 

BNE PASSLOP1 

MOVEM.L (A7)+,DO-D5/AO-A4 

RTS 

********* 

NEGATIVE: 

MOVEM.L D0-D3/A0-A2,-(A7) 
MOVE.L #PAGE1,A1 

MOVE.L #PAGE2,A2 

MOVE.L #$19300,DO 

NEGATO: 

MOVE.W #4095,D3 

MOVE.W (A2)+,D2 

SUB.W D2,D3 

MOVE.W D3,(Al)+ 

SUB.L #1,DO 

BNE NEGATO 

MOVEM.L (A7)+,D0-D3/A0-A2 

RTS 

********* 

SHOW: 

MOVEM.L D0-D3/A0,-(A7) 
RESIN: 

CLR.L D1 

MOVE.W #4,D1 

MOVE.L #$19300,D2 

MOVE.L #PAGE1,AO 

MOVE.B PAGE,D3 

CMP.B #2,D3 

BNE RES DO 

MOVE.L #PAGE2,AO 

RESDO: 

MOVE.W (A0),D3 

ROR.W D1,D3 

MOVE.W D3,(AO)+ 

SUB.L #1,D2 

BNE RESDO 

JSR HISTGRAM 

MOVE.B #9,BITPLANE 

NEXTPLAN: 

CLR.L DO 

MOVE.B BITPLANE,DO 

SUB.B #1,DO 

BEQ STOP 

MOVE.B DO,BITPLANE 

MOVE.W #BASEROW,Y 

NEXTLINE: 

JSR M 

JSR WR 

CLR.L DO 

MOVE.W Y,DO 

ADD.W #1,DO 

CMP.W #TOPROW,DO 

BEQ NEXTPLAN 

MOVE.W DO,Y 

BRA NEXTLINE 

STOP: 

MOVE.L #$19300,D2 

SUB.L #$32600,AO 

RESUNDO: 

MOVE.W (A0),D3 

ROL.W D1,D3 

MOVE.W D3,(AO)+ 

SUB.L #1,D2 

BNE RESUNDO 

MOVEM.L (A7)+,D0-D3/A0 
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December 


RTS 

********* 

BIGSHOW: 

MOVEM.L 

D0-D3/A0,-(A7) 

CLR.L 

D1 

MOVE.B 

#$4,D1 

MOVE.L 

#$19300,D2 

MOVE.L 

#PAGE2,AO 

BIGRESDO: 

MOVE.W 

(AO),D3 

ROR.W 

D1,D3 

MOVE.W 

D3, (AO) + 

SUB. L 

#1, D2 

BNE 

BIGRESDO 

MOVE.B 

#9,BITPLANE 

BIGPLAN: 

CLR.L 

DO 

MOVE.B 

BITPLANE,DO 

SUB. B 

# 1, DO 

BEQ 

STOP 

MOVE.B 

DO,BITPLANE 

MOVE.W 

#o,x 

MOVE.W 

#0, Y 

MOVE.L 

#24556,BIGX 

BIGLINE: 

JSR 

M 

JSR 

BIGWR1 

CLR.L 

DO 

MOVE. W 

Y, DO 

ADD. W 

#1, DO 

CMP. W 

#479,DO 

BEQ 

BIGPLAN 

MOVE. W 

DO, Y 

JSR 

M 

JSR 

BIGWR2 

SUB. L 

#2,BIGX 

CLR.L 

DO 

MOVE.W 

Y, DO 

ADD. W 

# 1, DO 

CMP. W 

#479,DO 

BEQ 

BIGPLAN 

MOVE.W 

DO, Y 

BRA 

BIGLINE 


BIGSTOP: 


MOVE.L #$19300,D2 
MOVE.L #PAGE2,AO 
BIGUNDO: 

MOVE.W (AO),D3 

ROL.W D1,D3 

MOVE.W D3,(AO)+ 

SUB.L #1,D2 

BNE BIGUNDO 

MOVEM.L (A7)+,D0-D3/A0 

RTS 

********* 


HISTGRAM SUBROUTINE 

* MAKES A HISTOGRAM OF THE PAGE TO BE SHOWN 

MISTGRAM: 

MOVEM.L D0-D3/A0-A1,-(A7) 

MOVE.L #HISTDATA,A1 
MOVE.W #256,DO 

HISTAO: 

MOVE.L #0,(Al)+ 

SUB.W #1,DO 

BNE HISTAO 

MOVE.L #HISTDATA,Al 

MOVE.L #$19300,DO 
MOVE.L #PAGE1,AO 
MOVE.B PAGE,D2 

CMP.B #1,D2 

BEQ HISTA1 

MOVE.L #PAGE2,AO 

HISTA1: 

CLR.L D1 

MOVE.W (A0)+,D1 

AND.W #$00FF,D1 

LSL.W #2,D1 

ADD.L #1,0(Al,D1) 

SUB.L #1,DO 

BNE HISTA1 

CLR.W D3 

MOVE.L #255,DO 

MOVE.W #BASEC0L1,D1 
MOVE.B PAGE,D2 
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CMP. B 
BEQ 

MOVE.W 
HISTOUT: 
CLR.L 
MOVE.L 
ADD. L 
CMP. L 
BLT 

MOVE.L 
HISTA2: 
LSR.W 
ADD. W 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 

MOVE.B 
JSR 

MOVE.B 

ROR.W 

JSR 

MOVE.B 

ROL.W 

JSR 

MOVE.B 

JSR 

MOVE.B 

JSR 

MOVE.B 

JSR 

MOVE.B 

ROR.W 

JSR 

MOVE.B 

ROL.W 

JSR 

MOVE.B 

JSR 

MOVE.B 

JSR 

MOVE.B 

JSR 

MOVE. B 

JSR 

MOVE.B 
JSR 

MOVE.B 
JSR 
MOVE.B 
ROR.W 
JSR 

MOVE. B 

ROL.W 

JSR 

MOVE. B 
JSR 

MOVE. B 
ADD. W 
ADD. W 
SUB. L 
BPL 

MOVEM.L 

RTS 

********* 

* 


M: 

MOVEM.L 
JSR 
MOVE.B 
MOVE.W 
JSR 

MOVE.B 
LSR 
JSR 
MOVE.B 
MOVE.W 
JSR 
MOVE.B 


#1,D2 
HISTOUT 
#BASECOL2,D1 

D2 

(Al)+,D2 
#63,D2 
#$7FF,D2 
HISTA2 
#$7FF,D2 

#5,D2 

#4,D2 

TEST 

#•C',VECOUT 
TEST 

D3,VECOUT 
TEST 

#0,VECOUT 
TEST 

# * M',VECOUT 
TEST 

D1,VECOUT 
#8, D1 
TEST 

Dl,VECOUT 

#8,D1 

TEST 

#4,VECOUT 
TEST 

#0,VECOUT 
TEST 

# * L',VECOUT 
TEST 

Dl,VECOUT 
#8 , Dl 
TEST 

Dl,VECOUT 
#8, Dl 
TEST 

D2,VECOUT 
TEST 

#0,VECOUT 
TEST 

# 'C*,VECOUT 
TEST 

#0,VECOUT 
TEST 

#0,VECOUT 
TEST 

# * L*,VECOUT 
TEST 

Dl,VECOUT 
#8, Dl 
TEST 

Dl,VECOUT 
#8, Dl 
TEST 

#68,VECOUT 
TEST 

#0,VECOUT 

#1,D1 

#1,D3 

# 1, DO 
HISTOUT 

(A7)+,D0-D3/A0-A1 


M SUBROUTINE 
PERFORMS VECTRIX 

M" 

0”VE COMMAND 

* X *,* Y' MUST CONTAIN THE SCREEN LOCATION YOU WISH TO MOVE TO 

DO,-(A7) 

TEST 

#'M',VECOUT 

X, DO 
TEST 

DO,VECOUT 
#8,DO 
TEST 

DO,VECOUT 

Y, DO 
TEST 

DO,VECOUT 
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LSR #8,DO 

JSR TEST 

MOVE.B DO,VECOUT 
MOVEM.L (A7)+,D0 
RTS 

* WR SUBROUTINE 

WRITE GRAPHICS RAM TO SCREEN, ONE LINE AND ONE PLANE PER INVOCATION 

* REQUIRES ' X' ,' Y' TO POINT TO SCREEN LOCATION OF 16 PIXEL BLOCK 

* AT WHICH LINE WILL BE DRAWN 

* REQUIRES 1 BITPLANE * TO HOLD THE NUMBER OF THE BITPLANE WE WILL USE 

* 'Y' IS USED AS AN OFFSET INTO THE GRAPHICS BUFFERS TO DETERMINE 

* PRESENT LINE 

* 

* *********** VECTRIX MUST BE IN FLASH MODE ************ 

* **************** poR WR TO RUN ********************** 


WR: 


MOVEM.L 

D0-D1/A0,-(A7) 


MOVE.W 

Y,DO *GET SCREEN Y VALUE 

SUB. W 

#BASEROW,DO 

♦GRAPHICS Y - SCREEN Y - BASEROW 

MULU 

#COLUMNS,DO 

♦POINT TO FIRST PIXEL IN LINE 

LSL.L 

#1,D0 

♦TIMES TWO FOR 16 BIT DATA 

MOVE.L 

DO,WRLINE 

♦SAVE THIS AS OFFSET TO PAGE 

MOVE.L 

#COLUMNS,DO 

♦FIGURE HOW MANY 16 BIT BLOCKS PER LINE 

DIVU 

#16,DO 

* 

MOVE.B 

DO,BLOCKS 

♦AND SAVE THE RESULT 

BSR 

TEST 

♦CHECK FOR BUSY TRANSMIT REGISTER 

MOVE.B 

#'W',VECOUT 

♦VECTRIX COMMAND = 



W"R BITPLANE COUNT 



B"£ 

MOVE.B 

#'R',VECOUT 


BSR 

TEST 


MOVE.B 

BITPLANE,VECOUT 

BSR 

TEST 


MOVE.B 

DO,VECOUT 

♦BLOCKS TO OUTPUT 

BSR 

TEST 



TEST 


MOVE.B 
MOVE.B 
SUB. B 
MOVE.B 
MOVE.L 
MOVE.B 
CMP 
BNE 

MOVE.L 
NOTPAGE2: 

ADDA.L 
WRLOOP1: 
MOVE.B 
CLR.L 
WRLOOP2: 
CLR.L 
MOVE.B 
ADD. L 
BTST 
BEQ 
ADD. L 
DONOTADD: 
LSR. L 
SUB. B 
BEQ 
BRA 

BLOCKSUB: 

BSR 

MOVE.B 
LSR. W 
BSR 

MOVE. B 
SUB. B 
BNE 

MOVEM.L 
WRDONE: 
RTS 

********* 
* 


#0,VECOUT *DONE WITH HEADER OF COMMAND, NOW FOR DATA 

BITPLANE,DO ♦BITPLANE (1..8) TO BIT (0..7) 

#1,D0 *BY SUBTRACTION OF ONE 

DO,BIT ♦AND SAVING THE RESULT 

#PAGE1,AO *POINT TO START OF PRIMARY PAGE AS CONTOUR 

PAGE,DO *GET PAGE NUMBER 

#2,DO *AND SEE IF WE SHOULD USE SECONDARY PAGE 


NOTPAGE2 
#PAGE2,A0 

WRLINE,AO 

#16,BYTE 
DO 

D1 

BIT,D1 

# 1, AO 
Dl,(AO)+ 
DONOTADD 
#$10000,DO 

# 1, DO 
#1,BYTE 
BLOCKSUB 
WRLOOP2 

TEST 

DO,VECOUT 
#8, DO 
TEST 

DO,VECOUT 

#1,BLOCKS 

WRLOOP1 

(A7)+,D0-D1/A0 


♦IF PAGE 
♦IF PAGE 


# <> 2 THEN DON'T USE PAGE 2 

# = 2 THEN POINT TO SECONDARY 


♦ADD OFFSET TO POINT TO A LINE WITHIN PAGE 
♦NUMBER OF BYTES PER BLOCK 

*USE Dl FOR BIT POINTER 
♦SEE IF BIT IS ON 

♦IF BIT IS ON, REFLECT IN OUTPUT WORD 
♦SHIFT INTO LOW BYTE 

♦WE'VE NOW ONE LESS BYTE TO FINISH BLOCK 
♦IF BLOCK FINISHED THEN SEND IT OUT 
♦IF NOT, GET NEXT BIT 

♦WE FINISHED OUTPUT WORD, NOW SEND IT 
♦TO THE VECTRIX, LOW BYTE 
♦SHIFT TO HIGH BYTE 

♦TO THE VECTRIX, HIGH BYTE 

♦WE'VE NOW ONE LESS BLOCK TO FINISH LINE 

♦IF LINE NOT DONE, GO DO NEXT BLOCK 


★♦A***************************************************************** 

BIGWR1 SUBROUTINE 
WRITE FULLSCREEN PAGE 2 

WRITE GRAPHICS RAM TO SCREEN, ONE LINE AND ONE PLANE PER INVOCATION 
REQUIRES 'X','Y' TO POINT TO SCREEN LOCATION OF 16 PIXEL BLOCK 
AT WHICH LINE WILL BE DRAWN 

REQUIRES 'BITPLANE' TO HOLD THE NUMBER OF THE BITPLANE WE WILL USE 
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* * Y 1 IS USED AS AN OFFSET INTO THE GRAPHICS BUFFERS TO DETERMINE 

* PRESENT LINE 

* 

* *********** VECTRIX MUST BE IN FLASH MODE************ 

* **************** for WR TO RUN ********************** 

* 

BIGWR1: 


MOVEM.L 

D0-D2/A0,-(A7) 

MOVE.W 

0, DO 

MOVE.B 

#42,BLOCKS 

BSR 

TEST 

MOVE.B 

#'W',VECOUT 

BSR 

TEST 

MOVE.B 

#'R',VECOUT 

BSR 

TEST 

MOVE.B 

BITPLANE,VECOUT 

BSR 

TEST 

MOVE.B 

#42,VECOUT 

BSR 

TEST 

MOVE.B 

#0,VECOUT 

MOVE.B 

BITPLANE,DO 

SUB. B 

# 1 / DO 

MOVE.B 

DO,BIT 

MOVE.L 

#PAGE2,AO 

ADDA.L 

BIGX,AO 

BIGLOOP1: 

MOVE.B 

#8,BYTE 

CLR.L 

DO 

BIGLOOP2: 

CLR.L 

D1 

MOVE.B 

BIT,D1 

ADD. L 

#512,AO 

MOVE.W 

(AO),D2 

SUB. L 

#512,AO 

ADD. W 

(AO),D2 

ADD. L 

#2,AO 

ADD. W 

(AO),D2 

ADD. L 

#512,AO 

ADD. W 

(AO),D2 

SUB. L 

#2,AO 

LSR.W 

#2, D2 

BTST 

D1,D2 

BEQ 

BNOTO 

ADD. L 

#$10000,DO 

BNOTO: 

LSR.L 

# 1, DO 

MOVE.W 

(AO),D2 

ADD. L 

#512,AO 

ADD. W 

(AO),D2 

ADD. L 

#2,AO 

ADD. W 

(AO),D2 

SUB. L 

#512,AO 

ADD. W 

(AO),D2 

SUB. L 

#2,AO 

LSR.W 

#2, D2 

BTST 

D1,D2 

BEQ 

BIGNOT 

ADD. L 

#$10000,DO 

BIGNOT: 

LSR.L 

# 1 # DO 

SUB. B 

#1,BYTE 

BEQ 

BIGSUB 

BRA 

BIGLOOP2 

BIGSUB: 

BSR 

TEST 

MOVE.B 

DO,VECOUT 

LSR.W 

#8,DO 

BSR 

TEST 

MOVE.B 

DO,VECOUT 

SUB. B 

#1,BLOCKS 

BNE 

BIGLOOP1 

MOVEM.L 

(A7)+,D0-D2/A0 

RTS 

********* 

* 

BIGWR2 SUBROUTINE 


* *********** VECTRIX MUST BE IN FLASH MODE************ 

* **************** FOR WR TO RUN ********************** 

* 

BIGWR2: 

MOVEM.L D0-D2/A0,-(A7) 

MOVE.W 0, DO 

MOVE.B #42,BLOCKS 

BSR TEST 

MOVE.B # »W»,VECOUT 

BSR TEST 

MOVE.B # ' R' ,VECOUT 
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BSR 

TEST 

MOVE. B 

BITPLANE,VECOUT 

BSR 

TEST 

MOVE.B 

#42,VECOUT 

BSR 

TEST 

MOVE.B 

#0,VECOUT 

MOVE.B 

BITPLANE,DO 

SUB. B 

#1,D0 

MOVE.B 

DO,BIT 

MOVE.L 

#PAGE2,AO 

ADDA.L 

BIGX.AO 

BIGL0021: 

MOVE.B 

#8,BYTE 

CLR.L 

DO 

BIGL0022: 

CLR.L 

D1 

MOVE.B 

BIT, D1 

ADD.L 

#512,AO 

MOVE.W 

(AO),D2 

SUB. L 

#2,AO 

ADD. W 

(AO),D2 

SUB. L 

#512,AO 

ADD. W 

(AO),D2 

ADD.L 

#2,AO . 

ADD. W 

(AO),D2 

ADD.L 

#512,AO 

LSR.W 

#2, D2 

BTST 

D1,D2 

BEQ 

BNOT20 

ADD.L 

#$10000,DO 

BNOT20: 

LSR.L 

#1,D0 

MOVE.W 

(AO),D2 

BTST 

D1,D2 

BEQ 

BIGNOT2 

ADD.L 

#$10000,DO 

BIGNOT2: 

LSR.L 

»i,do 

SUB. B 

#1,BYTE 

BEQ 

BIGSUB2 

BRA 

BIGIX5022 

BIGSUB2: 

BSR 

TEST 

MOVE.B 

DO,VECOUT 

LSR.W 

#8,DO 

BSR 

TEST 

MOVE.B 

DO,VECOUT 

SUB. B 

#1,BLOCKS 

BNE 

BIGL0021 

MOVEM.L 

(A7)+ ,DO-D2/AO 

RTS 


********* 

* TEST SUBROUTINE 

* WAITS UNTIL THE TRANSMIT BUFFER IS EMPTY 
TEST: 

BTST # 0,VECSTAT 

BEQ TEST 

BTST # 7,VECSTAT 

BEQ TEST 

RTS 

********* 

* SUBROUTINE BIAS 

MOVES PRIMARY GRAPHICS DATA TO SECONDARY DATA SPACE 

BIAS: 

MOVEM.L D0-D4/A0-A2,-(A7) 

MOVE.L #$19300,DO 

MOVE.L #PAGE1,AO 

MOVE.L #PAGE2,A1 

MOVE.L A1,D1 

ADD.L #514,D1 

MOVE.L D1,A2 

CLR.L D2 

BIASLOOP: 

MOVE.W (A1)+,D2 

SUB.W (A2)+,D2 

ASR.W #1,D2 

ADD.W #2047,D2 

MOVE.W D2 , (AO) + 

SUB.L #1,DO 

BNE BIASLOOP 

MOVEM.L (A7)+,D0-D4/A0-A2 

RTS 
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PTOS: 
MOVEM.L 
MOVE.L 
MOVE.L 
MOVE.L 
PTOSLOOP: 
MOVE.W 
SUB. L 
BNE 

MOVEM.L 

RTS 

********* 


SUBSTOP: 
MOVEM.L 
MOVE.L 
MOVE•L 
MOVE.L 
SUBLOOP: 
CLR.L 
CLR.L 
MOVE.W 
MOVE.W 
SUB. L 
BGE 
CLR.L 
SUBNOT: 
MOVE.W 
SUB. L 
BNE 

MOVEM.L 

RTS 

********* 

* 

* 

ACSYNC: 
MOVEM.L 
MOVE.W 
SYNCO: 

MOVE.W 
SYNC1: 
MOVE.W 
BTST 
BEQ 
ROL.W 
BCHG 
NOT. W 
AND. W 
CMP. W 
BGT 
CMP. W 
BLT 
ADD. W 
BRA 
SYNC2: 

CMP. W 
BGT 

MOVEM.L 

RTS 

********* 

* 

* 

RCAIN: 
MOVEM.L 
MOVE. B 
MOVE. L 
MOVE. L 
ADD. L 
JSR 
JSR 
MOVE.W 
VERTCLK: 
MOVE.B 
JSR 
VERTO: 

SUB. B 
BNE 

MOVE.B 
MOVE.B 
MOVE.B 
VERT2: 

SUB. B 


SUBROUTINE PTOS 

MOVES PRIMARY GRAPHICS DATA TO SECONDARY DATA SPACE 

D0/A0-A1,-(A7) 

#$19300,DO 
#PAGE1,AO 
# PAGE2,A1 

(A0)+,(A1)+ 

#1,D0 

PTOSLOOP 

(A7 ) 4*, D0/A0-A1 


SUBSTOP SUBROUTINE 

SUBTRACTS SECONDARY FROM PRIMARY, RESULTS TO PRIMARY 

D0-D2/A0-A1,-(A7) 

#$19300,DO 
#PAGE1,AO 
#PAGE2,A1 

D1 

D2 

(A1)+,D1 
(AO),D2 
D1,D2 
SUBNOT 
D2 

D2,(A0)+ 

# 1, DO 
SUBLOOP 

(A7)+,D0-D2/A0-A1 


SUBROUTINE ACSYNC 

SYNCRONIZES ROW READS WITH 60Hz LINE FREQUENCY 

D0-D1/A0,-(A7) 

#0, DO 

# $C7 0 0,A_D_DATA 

A__D_DATA, D1 
#7, D1 
SYNC1 
#8, D1 
#11,D1 
D1 

#$0FFF,D1 
#5,DO 
SYNC2 
#200,D1 
SYNCO 
#1 , DO 
SYNCO 

#272,D1 
SYNCO 

(A7)+,D0-D1/A0 


SUBROUTINE RCAIN 

READS A FRAME FROM RCA SID-504 CCD 
D0-D7/A0-A1,-(A7) 

#$4,SELECT ^SELECT PARALLEL PORT (CCD) 

#PAGE1,AO 

AO, A1 

#806,A1 

EXPTIME 

CV 

#256,DO 

HORTIME,D2 
ACSYNC 

#1,D2 

VERTO 

#$20,PARDATA 
#$60,PARDATA 
VERTIME,D2 

#1,D2 
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BNE 

VERT2 

JSR 

HORIZCLK 

SUB. W 

#1, DO 

BNE 

VERTCLK 

MOVEM.L 

(A7)+,D0-D7/A0-A1 

JSR 

FLIP 

JSR 

MANSCR 

RTS 

********* 

* 

SUBROUTINE HORIZCLK 

HORIZCLK: 

MOVEM.L 

DO-D2,-(A7) 

MOVE.W 

#14,DO 

DREGS1: 

MOVE.B 

#$40,PARDATA 

MOVE.B 

#$60,PARDATA 

MOVE.B 

HORTIME,D2 

HZL9: 

SUB. B 

#1,D2 

BNE 

HZL9 

SUB. W 

# 1, DO 

BNE 

DREGS1 

MOVE.W 

#403,DO 

HORIZ1: 

MOVE.B 

#$40,PARDATA 

MOVE.B 

#$60,PARDATA 

MOVE.B 

ADTIME,D2 

HZLO: 

SUB. B 

#1,D2 

BNE 

HZLO 

MOVE.W 

#$C100,A_D_DATA 

ADDONE: 


MOVE.W 

A D DATA, D1 

BTST 

#7, D1 

BEQ 

ADDONE 

ROL.W 

#8,D1 

BCHG 

111,D1 

NOP 

AND. W 

#$0FFF,D1 

MOVE.W 

Dl,(AO)+ 

SUB. W 

#1, DO 

BNE 

HORIZ1 

MOVE.W 

#14,DO 

DREGS: 

MOVE.B 

#$40,PARDATA 

MOVE.B 

#$60,PARDATA 

MOVE.B 

HORTIME,Dl 

DREGO: 

SUB. B 

#1,D1 

BNE 

DREGO 

SUB. W 

#1, DO 

BNE 

DREGS 

MOVEM.L 

(A7)+,D0-D2 

RTS 


********* 


* SUBROUTINE CLEAR CCD 

CLEARCCD: 

MOVEM.L D0-D2,-(A7) 

Move!w »254?DO ECT * SELECT PARALLEL PORT (CCD) 
CVERTCLK: 

MOVE.B # 1, D2 
CVERTO: 

SUB.B #1,D2 
BNE CVERTO 

MOVE.B #$20,PARDATA 
MOVE.B # $60,PARDATA 

MOVE.B VERTIME,D2 

CVERT2: 

SUB.B #1,D2 
BNE CVERT2 

JSR CHORIZ 

SUB.W #1,DO 

BNE CVERTCLK 

JSR CV 

MOVEM.L (A7)+,D0-D2 
RTS 

********* 

* SUBROUTINE CHORIZ 

CHORIZ: 

MOVEM.L D0-D1,-(A7) 

MOVE.W #427,DO 
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CH0RIZ1: 
MOVE.B 
MOVE.B 
MOVE•B 
CXHZO: 
SUB. B 
BNE 
SUB. W 
BNE 

MOVEM.L 

RTS 

********* 


CV: 

MOVEM.L 
MOVE•W 
CV1: 

MOVE. B 
MOVE. B 
MOVE.B 
CV2: 

SUB. B 
BNE 

MOVE.W 
CVHOR: 
MOVE.B 
MOVE. B 
MOVE.B 
CVO: 

SUB. B 
BNE 
SUB. W 
BNE 
SUB. W 
BNE 

MOVEM.L 

RTS 

********* 

* 

* 

EXPTIME: 
MOVEM.L 
MOVE. B 
MOVE. L 
JSR 
JSR 
MOVE.B 
MOVE.B 
JSR 
MOVE. B 
MOVE. B 
JSR 
MOVE.B 
MOVE.B 
JSR 
MOVE.B 
MOVE. B 
JSR 
MOVE.B 
MOVE.B 
JSR 
JSR 
JSR 
MOVE.W 
BIGTIME: 

MOVE.L 
TIMEOUT: 
SUB. L 
BNE 
SUB. W 
BNE 

MOVEM.L 

RTS 

********* 

* 

* 

FLIP: 
MOVEM.L 
MOVE.L 
MOVE.L 
FLIPO: 
MOVE.W 
SUB. L 
BNE 

MOVE•L 


#$40,PARDATA 
#$60,PARDATA 
HORTIME,D1 

#1,D1 
CXHZO 
#1,D0 
CHORIZ1 
(A7)+,D0-D1 


SUBROUTINE CV MOVE FROM IMAGE TO STORAGE 

D0-D3,-(A7) 

#256,D2 

#$20,PARDATA 
#$60,PARDATA 
VERTIME,D1 

# 1 r D1 
CV2 
#3, D3 

#$40,PARDATA 
#$60,PARDATA 
HORTIME,DO 

#1,D0 

CVO 

# 1, D3 
CVHOR 
#1,D2 
CV1 

(A7) +,D0-D3 


SUBROUTINE EXPTIME 
TIMES OUT CCD EXPOSURE 

D0-D1/A1,-(A7) 

$1A,SYSIO 
#EXPMSG,A1 
MSGOUT 
TESTOUT 
EXPTIME1,D1 
Dl,SYSIO 
TESTOUT 
EXPTIME2,Dl 
Dl,SYSIO 
TESTOUT 
EXPTIME3,Dl 
Dl,SYSIO 
TESTOUT 
#'.•,01 
Dl,SYSIO 
TESTOUT 
EXPTIME4,Dl 
Dl,SYSIO 
CLEARCCD 
CLEARCCD 
CLEARCCD 

EXPOSURE,Dl * 556701 » 1 SECOND 

#55670,DO 

# 1, DO 

TIMEOUT 

#1,D1 

BIGTIME 

(A7)+,D0-D1/A1 


SUBROUTINE FLIP 

FLIPS IMAGE TO FIT SCREEN 

D0-D2/A0-A1,-(A7) 

#$19300,DO 
#PAGE2,A1 

#0,(Al)+ 

#1,D0 

FLIPO 

#PAGE2,A1 
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MOVE.W 
MOVE. L 
FLIP1: 

MOVE. W 
FLIP2: 
MOVE. W 
ADD. L 
SUB. W 
BNE 

MOVE.L 
ADD. W 
CMP. W 
BEQ 
ADD. W 
BRA 

FLIPOUT: 
MOVE.L 
MOVE.L 
MOVE.L 
FLIP3: 
MOVE. W 
SUB. L 
BNE 

MOVEM.L 

RTS 

********* 

* 

* 

* 

VECINIT: 
MOVEM.L 
MOVE.B 
MOVEA.L 
LOOP1: 
MOVE.B 
CMP. B 
BEQ 
BSR 

MOVE.B 
BRA 

INITDONE: 
MOVEM.L 
RTS 

********* 


TESTIN: 

JSR 

JSR 

BTST 

BEQ 

RTS 

********* 

* 

* 

INNOTIME: 

JSR 

BTST 

BEQ 

RTS 

********* 

* 

* 

TESTOUT: 

BTST 

BEQ 

RTS 

********* 

* 

* 

REPORT: 
MOVEM.L 
MOVE.L 
JSR 

MOVE.L 
MOVE.L 
REPLP: 
SUB. L 
BEQ 

MOVE.L 
MULU 
MOVE.L 
BEQ 


#0,D1 
#PAGE1,AO 

#403,DO 

(AO)+ ,(Al) 

#512,A1 
#1, DO 
FLIP2 
#PAGE2,Al 
#2, D1 
#512,D1 
FLIPOUT 
D1,A1 
FLIP1 

#PAGE1,AO 
#PAGE2,Al 
#$19300,DO 

(Al)-f, (A0) + 

#1, DO 
FLIP3 

(A7)+,D0-D2/A0-A1 


VECINIT SUBROUTINE 

INITIALIZE VECTRIX FOR 2D, BLACK SCREEN, REPLACE MODE, 
HEX MODE OPERATION 

DO/AO,-(A7) 

#$4,SELECT *SELECT VECTRIX 

#VECDATA,AO 

(AO)-*-,DO 

#'+',D0 *EQUAL TO END CHARACTER? 

INITDONE 

TEST 

DO,VECOUT 
LOOP1 

(A7)+,DO/AO 


TESTIN SUBROUTINE 

WAITS UNTIL THE TRANSMIT BUFFER IS EMPTY AND THE RECIEVE BUFFER 
CONTAINS AN INPUT CHARACTER 

TIME 

TESTOUT 

#1,SYSST 

TESTIN 


INNOTIME SUBROUTINE 

SAME AS TESTIN, BUT NO TIME 

TESTOUT 

#1,SYSST 

INNOTIME 


TEST SUBROUTINE 

WAITS UNTIL THE TRANSMIT BUFFER IS EMPTY 

#0,SYSST 
TESTOUT 


REPORT PROGRAM 

GENERATES OUTPUT LISTING OF VITAL STATS OF GROUPS 

D0-D5/A0-A1,-(A7) 

#RPTMSG0,Al 
MSGOUT 
#256,D3 
#AREA,AO 

# 1, D3 
REPDONE 
D3,D1 
#4,D1 

0(AO,Dl),D2 
REPLP 
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MOVE.L 

D3, DO 

MOVE.L 

#RPTMSG1,A1 

JSR 

MSGOUT 

JSR 

STASHDO 

JSR 

INTOUT 

MOVE.L 

D2, DO 

MOVE.L 

#RPTMSG2,A1 

JSR 

MSGOUT 

JSR 

STASHDO 

JSR 

INTOUT 

MOVE.L 

#BRIGHT,AO 

MOVE.L 

0(AO,Dl),DO 

MOVE.L 

#RPTMSG3,A1 

JSR 

MSGOUT 

JSR 

STASHDO 

JSR 

INTOUT 

DIVU 

#2, Dl 

MOVE.L 

#VMAX,AO 

CLR.L 

DO 

MOVE.W 

0(AO,Dl),DO 

MOVE.L 

#RPTMSG4,A1 

JSR 

MSGOUT 

JSR 

STASHDO 

JSR 

INTOUT 

MOVE.L 

#VMIN,AO 

CLR.L 

DO 

MOVE.W 

0(AO,Dl),DO 

MOVE.L 

#RPTMSG5,A1 

JSR 

MSGOUT 

JSR 

STASHDO 

JSR 

INTOUT 

MOVE.L 

#HMAX,AO 

CLR.L 

DO 

MOVE.W 

0 (AO, Dl) , DO 

MOVE.L 

#RPTMSG6,A1 

JSR 

MSGOUT 

JSR 

STASHDO 

JSR 

INTOUT 

MOVE.L 

#HMIN,AO 

CLR.L 

DO 

MOVE.W 

0(AO,Dl),DO 

MOVE.L 

#RPTMSG7,A1 

JSR 

MSGOUT 

JSR 

STASHDO 

JSR 

INTOUT 

MOVE.L 

#RPTMSG8,A1 

JSR 

MSGOUT 

MOVE.L 

#RPTMSG9,A1 

JSR 

MSGOUT 

MOVE.L 

#RPTMSGA,A1 

JSR 

MSGOUT 

MOVE.L 

#AREA,AO 

JSR 

WAIT 

BRA 

REPLP 

REPDONE: 

MOVEM.L 

(A7)+,D0-D5/A0-A1 

RTS 

********* 

MSGOUT: 

MOVE.L 

DO,-(A7) 

MSGLOOP: 

CLR.W 

DO 

MOVE.B 

(A1)+,DO 

CMP. B 

# * + * , DO 

BEQ 

MSGOVER 

CMP. B 

I* \D0 

BNE 

NOTCAR 

MOVE.B 

#13,DO 

JSR 

TESTOUT 

MOVE.B 

DO,SYSIO 

MOVE.B 

#10,DO 

NOTCAR: 

JSR 

TESTOUT 

MOVE.B 

DO,SYSIO 

BRA 

MSGLOOP 

MSGOVER: 

MOVEM.L 

(A7) +,DO 

RTS 

********* 

STASHDO: 

MOVEM.L 

D1-D3/A0-A2 ,-(A7) 

MOVE.L 

D0,D2 

MOVE.L 

#MARK1,A0 

MOVE.B 

#10,D3 

LOOP: 

MOVE.L 

D2,D1 
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MOVE.L 

D1, DO 

JSR 

STUFFDO 

MOVE.L 

#10,DO 

JSR 

STUFFDO 

MOVE.B 

# $ 2 F,MATHCMD 

JSR 

YANKDO 

MOVE.L 

DO, D2 

JSR 

STUFFDO 

MOVE.L 

#10,DO 

JSR 

STUFFDO 

MOVE.B 

#$2E,MATHCMD 

JSR 

YANKDO 

SUB. L 

DO, D1 

ADD. B 

#$30,D1 

MOVE.B 

D1,-(A0) 

SUB. B 

#1,D3 

BNE 

LOOP 

MOVEM. L 
RTS 

(A7) 4-, D1-D3/A0-A2 


* * * * * * * * * 
YANKDO: 


MOVE.B 

MATHDATA,DO 

ASL.L 

#8, DO 

MOVE. B 

MATHDATA,DO 

ASL.L 

#8, DO 

MOVE. B 

MATHDATA,DO 

ASL.L 

#8, DO 

MOVE.B 
RTS 

MATHDATA,DO 


********* 


STUFFDO: 

MOVE.B DO,MATHDATA 

ROR.L #8,DO 

MOVE.B DO,MATHDATA 

ROR.L #8,DO 

MOVE.B DO,MATHDATA 

ROR.L #8,DO 

MOVE.B DO,MATHDATA 

RTS 

********* 


* DECOUT SUBROUTINE 

* OUTPUTS TEN DIGIT NUMBER WITH 
DECOUT: 

MOVEM.L DO-D1/AO,-(A7) 

JSR DECPOINT 

MOVE.B #11,D1 

MOVE.L #DECIMAL,AO 

DECLOOP: 

MOVE. B (AO) 4-, DO 

JSR TESTOUT 

MOVE.B DO,SYSIO 

SUB. B U,D1 

BNE DECLOOP 

MOVEM.L (A7) 4*,DO-D1/AO 

RTS 

********* 


DECIMAL POINT AFTER 3rd DIGIT 


* 

* 

INTOUT: 
MOVEM.L 
JSR 
MOVE.B 
MOVE.L 
INTLOOP: 
MOVE.B 
CMP. B 
BEQ 
JSR 
MOVE.B 
ZOUT: 
SUB. B 
BNE 

MOVEM.L 
RTS 


INTOUT SUBROUTINE 

OUTPUTS TEN DIGIT INTEGER REPRESENTATION OF LONG WORD 

D0-D1/A0-A1,-(A7) 

KRUNCH 
#10,D1 
#DECIMAL,AO 

(AO) 4-, DO 
#' \D0 
ZOUT 
TESTOUT 
DO,SYSIO 

#1,D1 

INTLOOP 

(A7) 4-, D0-D1/A0-A1 


********* 


* PLACES DECIMAL POINT IN DECIMAL NUMBER 

DECPOINT: 

MOVEM.L DO/AO,-(A7) 

MOVE.L #DECIMAL,AO 

MOVE.B #8,DO 

ADDA.L #11,AO 
FIXLOOP1: 

MOVE.B -(AO),1(A0) 

SUB.B #1,DO 
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BNE 

MOVE.B 

MOVEM.L 

RTS 

********* 

* 

* 

KRUNCH: 
MOVEM.L 
MOVE.L 
MOVE.B 
KRLOOP: 
MOVE.B 
CMP. B 
BNE 

MOVE.B 
SUB. B 
BNE 

KRDONE: 
MOVEM.L 
RTS 

********* 

* 

WAIT: 

MOVE. L 
MOVE.L 
WAITLOOP: 
SUB. L 
BNE 

MOVE.L 
RTS 

********* 

* 

* 

SCREEN: 
MOVEM.L 
MOVE. L 
MESSAGE: 
MOVE.B 
CMP. B 
BEQ 
CMP. B 
BNE 
JSR 
MOVE. B 
MOVE.B 
NOCAR: 

JSR 

MOVE.B 
BRA 

MSGDONE: 

MOVEM.L 

RTS 

********* 

* 

* 

MANSCR: 
MOVEM.L 
MOVE•L 
MANMESS: 
MOVE.B 
CMP. B 
BEQ 
CMP. B 
BNE 
JSR 
MOVE.B 
MOVE.B 
MNOCAR: 

JSR 

MOVE.B 
BRA 

MMSGDONE: 

MOVEM.L 

RTS 

********* 

* 

* 

AUTOSCR: 
MOVEM.L 
MOVE.L 
AUTOMESS: 
MOVE.B 
CMP. B 
BEQ 
CMP. B 


FIXLOOP1 
#’.\(A0) 
(A7)+,DO/AO 


KRUNCH SUBROUTINE 

REMOVES UNWANTED ZEROS FROM NUMBERS 

D0-D1/A0,-(A7) 

#DECIMAL,AO 
#9, DO 

(AO),D1 
ro»,Di 
KRDONE 
#' 1 ,(AO)+ 

#l,DO 

KRLOOP 

(A7)+,DO-D1/AO 


WAIT SUBROUTINE 

DO,-(A7) 
#$2FFFFF,DO 

# 1 , DO 
WAITLOOP 
( A7) 4 * , DO 


SCREEN SUBROUTINE 
SHOWS TOP MENU 

DO/AO,-(A7) 

#MENU1,AO 

(AO) 4-, DO 
#•+' ,D0 
MSGDONE 
,D0 
NOCAR 
TESTOUT 
#10,SYSIO 
#13,DO 

TESTOUT 
DO,SYSIO 
MESSAGE 

(A7) 4-, DO/AO 


MANSCR SUBROUTINE 

SHOWS MENU FOR MANUAL MODE 

DO/AO,-(A7) 

#MENU2,AO 

(AO) 4 * , DO 
# ' + * ,DO 
MMSGDONE 
# , _»,D0 
MNOCAR 
TESTOUT 
#10,SYSIO 
#13,DO 

TESTOUT 
DO,SYSIO 
MANMESS 

(A7) 4 - , DO/AO 


AUTOSCR SUBROUTINE 

SHOWS MENU FOR AUTOMATIC MODE 

DO/AO,-(A7) 

#MENU3,AO 

(AO)+,DO 
#,D0 
AMSGDONE 
#' *,DO 
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BNE 
JSR 
MOVE.B 
MOVE.B 
ANOCAR: 
JSR 
MOVE.B 
BRA 

AMSGDONE: 

MOVEM.L 

RTS 

********* 

* 

* 

TIME: 
MOVEM.L 
JSR 
MOVE.L 
MOVE.L 
JSR 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE. B 
JSR 
MOVE. B 
JSR 
MOVE.B 
JSR 
MOVE.B 
JSR 
MOVE.B 
MOVE.L 
JSR 
JSR 
MOVE.B 
JSR 
MOVE.B 
MOVE.L 
JSR 
JSR 
MOVE.B 
JSR 
MOVE.B 
MOVE.L 
JSR 
JSR 
MOVE.B 
JSR 
MOVE.B 
MOVEM.L 
RTS 

********* 

* 

* 

CLOCK: 
MOVEM.L 
MOVE.L 
MOVE.B 
CLKLOOP1: 
MOVE.B 
OR. B 
MOVE.B 
MOVE.B 
CMP. B 
BNE 
AND. B 
CLKA1: 

ADD. B 
MOVE.B 
SUB. B 
BPL 

MOVE.B 

MOVEM.L 

RTS 

********* 

* 

* 

ACKMSG: 

MOVEM.L 


ANOCAR 
TESTOUT 
#10,SYSIO 
#13,DO 

TESTOUT 
DO,SYSIO 
AUTOMESS 

(A7)+,DO/AO 


TIME SUBROUTINE 

PUTS TIME AND DATE STUFF ON SCREEN 

D0-D1/A0-A1,-(A7) 

CLOCK 

#TIMEDATA,AO 

#TIMEMSG1,A1 

MSGOUT 

TESTOUT 

2(AO),SYSIO 

TESTOUT 

3(AO),SYSIO 

TESTOUT 

#'/',SYSIO 

TESTOUT 

4(AO),SYSIO 

TESTOUT 

5(AO),SYSIO 

TESTOUT 

#*/',SYSIO 

TESTOUT 

0(AO),SYSIO 

TESTOUT 

1(AO),SYSIO 

#TIMEMSG2,A1 

MSGOUT 

TESTOUT 

7(AO),SYSIO 

TESTOUT 

8(AO),SYSIO 

#TIMEMSG3,A1 

MSGOUT 

TESTOUT 

9(AO),SYSIO 

TESTOUT 

10(AO),SYSIO 

#TIMEMSG4,A1 

MSGOUT 

TESTOUT 

11(AO),SYSIO 

TESTOUT 

12(AO),SYSIO 

( A7) +,D0-D1/A0-A1 


CLOCK SUBROUTINE 

GETS THE TIME AND STORES IT 

D0-D1/A0,-(A7) 

#TIMEDATA,AO 
#$C,DO 

#$50,D1 
DO, D1 
D1,CLKCMD 
CLKDATA,D1 
#5,DO 
CLKA1 
# 3, D1 

#$30,D1 
Dl,(AO)+ 

#1,D0 
CLKLOOP1 
#0,CLKCMD 
(A7)+,D0-D1/A0 


IN THE DATA AREA AS TIMEDATA 


ACKMSG SUBROUTINE 
ACKNOWLEGE A MENU CHOICE 

DO/AO,-(A7) 


continued 
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MOVE. L 
MOVE.L 
JSR 
MOVE.B 
ADDA.L 
ACKLOOP: 
JSR 

MOVE.B 
SUB. B 
BNE 

MOVEM.L 

RTS 

********* 
.DATA 
VECDATA: 

. DC. B 
MENU1: 

. DC. B 
. DC. B 
. DC. B 
.DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 
MENU2: 

. DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 
ACKMSG20: 
ACKMSG21: 
ACKMSG22: 
ACKMSG23: 
ACKMSG24: 
ACKMSG25: 
ACKMSG26: 
ACKMSG27: 
ACKMSG28: 
ACKMSG29: 
ACKMSG2A: 
ACKMSG2B: 
ACKMSG2C: 
ACKMSG2D: 
ACKMSG2E: 
ACKMSG2F: 
ACKMSG2G: 
ACKMSG2H: 
ACKMSG2I: 
ACKMSG2J: 
ACKMSG2K: 
ACKMSG2L: 
ACKMSG2M: 
ACKMSG2N: 
ACKMSG20: 
ACKMSG2P: 
ACKMSG2R: 
ACKMSG2S: 
ACKMSG2T: 
ACKMSG2U: 
ACKMSG2V: 
ACKMSG2W: 
ACKMSG2X: 
ACKMSG2Y: 
ACKMSG2Z: 

. DC. B 
ACKMSG3C: 
ACKMSG3F: 
RDYMSG2: 
MENU3: 

. DC. B 


A1, AO 

#ACKMESS,A1 
MSGOUT 
#22,DO 

#2,AO *DON'T PRINT CHARACTER OF CHOICE 

TESTOUT 
(AO)+,SYSIO 
#1,D0 
ACKLOOP 
(A7)+ ,DO/AO 


★INITIALIZED DATA 

.DC.B *G JM2 RE KF EO C73 P4 63 69 63 473 320 473 320 69 

•P4 335 69 335 473 593 473 593 69 HX+• 

.DC.B $1A 

1 HOW FORTUNATE YOU ARE TO GAZE UPON THE' 

* SPLENDOR OF_* 

» *** THE TOTALY WOTALY FERRET CCD AND TELESCOPE* 

* CONTROLLER PROGRAM ***_• 

* by CLIFFORD HARRIS of 99 MASON RD. YERINGTON, NV. 89447 * 

•DATE: ll/24/86_' 

t i 

'COORDINATED UNIVERSAL TIME: 23h 59m 59s ' 

» i ~ 


'PLEASE CHOOSE ONE OF THE FOLLOWING:' 

'0 AUTOMATIC MODE_» 

'1 MANUAL MODE_» 

•2 SET TIMING ( HORIZONTAL/2, VERTICAL/8, AD/8 ) ' 

'3 SET EXPOSURE TIME IN 1/10 SECONDS (GIVE FOUR DIGITS) ' 
'Q QUIT_' 

' _ +• 

DC. B $ 1A 

' THE WONDERFUL FERRET CCD AND TELESCOPE' 

» CONTROLLER PROGRAM* 

» *#*#* THE INCREDIBLE MANUAL MODE' 

• *#*#*_• 

• t 

'DATE: 12/30/85_' 

i t 

'COORDINATED UNIVERSAL TIME: 23h 59m 59s ' 

i i 


. DC. B 

'0 

CCD IN 


. DC. B 

'1 

PAGE1 TO PAGE2 


. DC. B 

'2 

AVERAGE 


. DC. B 

•3 

FIX BAD PIXELS 


. DC. B 

'4 

COLORS 


. DC. B 

'5 

PAGE2 TO FULL SCREEN 


. DC. B 

•6 

LOG 


. DC. B 

•7 

DISPLAY PAGE1 


. DC. B 

'8 

DISPLAY PAGE2 


. DC. B 

»9 

GROUPS 


. DC. B 

'A 

MAGNIFY 2X 


. DC. B 

•B 

REPORT ON GROUPS 


• DC. B 

'C 

SAVE PAGE1 


. DC. B 

'D 

SCREEN COLOR VALUES 


• DC. B 

•E 

SWIRL COLORS 


. DC. B 

'F 

RESTORE 


. DC. B 

'G 

DARK FIELD 


. DC. B 

'H 

SUBTRACT PAGE1-PAGE2 


. DC. B 

'I 

FLAT FIELD 


. DC. B 

'J 

BAS RELIEF 


. DC. B 

'K 

CONTRAST ENHANCE 


. DC. B 

'L 

SCREEN CURSOR 


. DC. B 

'M 

BLACK BACKGROUND 


. DC. B 

'N 

NEGATIVE 


. DC. B 

'0 

ADD CONSTANT 


. DC. B 

'P 

SUBTRACT CONSTANT 


. DC. B 

'R 

PAGE1 TO DARKFIELD 


. DC. B 

'S 

PAGE1 TO FLATFIELD 


. DC. B 

'T 

STAROUT 5X5 


. DC. B 

'U 

3-D GRAPH 


. DC. B 

'V 

HIGHPASS FILTER 


• DC. B 

»W 

MAP BAD PIXELS 


. DC. B 

'X 

STAROUT 15X15 MEDIAN 


. DC. B 

•Y 

MEAN AND STANDARD DEV ' 

. DC. B 

'Z 

DIFFERENCE 


. DC. B 

*Q 

QUIT ' 


$0D,$0A, 

$0A, 

• + ' 


. DC. B 

i 

SAVE IMAGE (0-9,A-Z) 

? 

. DC. B 

t 

RESTORE IMAGE (0-9,A-Z) 

. DC. B 

i 

VOTT IS YOUR VISH? 



. DC. B $1A 

' THE MIND-EXPANDING FERRET CCD AND TELESCOPE' 
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• DC. B 

• DC. B 
. DC. B 

• DC. B 
. DC. B 
. DC. B 
. DC. B 
. DC. B 

• DC. B 
. DC. B 
. DC. B 

• DC. B 
. DC. D 

• DC. B 


CONTROLLER PROGRAM_• 

!!!! THE AMAZINGLY AMAZING AUTOMATIC* 

MODE !!!! _* 

DATE: 12/30/85_* 


COORDINATED UNIVERSAL TIME: 

i 

PRESENT TELESCOPE COORDINATES: 
DEC. - -89d 59m 59s_* 

i 

INTEGRATION TIME: 99 min 

i 

TIME LEFT ON THIS EXPOSURE: 


23h 59m 59s_* 

R.A. = 23h 59m 59.9s_* 

59 sec* 

99 min 59 sec* 


.DC. B 

* NOT A 

LOT TO CHOOSE FROM 

. DC. B 

* TYPE 

THE LETTER Q_' 

. DC. B 

i i 


. DC. B 

'Q QUIT ' 

. DC. B 

' + ' 


TIMEMSG1: 

• DC. B 

$1B,'.0',$1B,'«# 

TIMEMSG2: 

• DC. B 

$1B, ' =*%C+' 

TIMEMSG3: 

• DC. B 

$1B, '* % D+' 

TIMEMSG4: 

• DC. B 

$1B,'=%H+' 

ACKMESS: 

• DC. B 

$1B,'“6 +' 

ENDMSG: 

• DC. B 

' ',$1B,'.1 +» 

RPTMSGO: 

• DC. B 

$1B,' 

. DC. B 

*♦♦ THE ASTOUNDING REPORT 

RPTMSG1: 

• DC. B 

SIB, 

. DC. B 

* GROUP 

# ' /$1B,' = ,*+■ 

RPTMSG2: 

• DC. B 

$1B, ' —! • 

. DC. B 

* AREA 

- ',$1B,2+' 

RPTMSG3: 

. DC. B 

$1B,1• 

. DC. B 

* BRIGHTNESS - ',$1B 

RPTMSG4: 

• DC. B 

$1B, <-/<.< 

. DC. B 

'VERTICAL MAX - ',$1B 

RPTMSG5: 

• DC. B 

$1B,'-0!* 

. DC. B 

•VERTICAL MIN - *,$1B 

RPTMSG6: 

• DC. B 

$1B,•=!!• 

. DC. B 

'HORIZONTAL MAX - ',$1B, 

RPTMSG7: 

. DC. B 

$1B,*-21' 

. DC. B 

•HORIZONTAL MIN = '$18, 

RPTMSG8: 

. DC. B 

$1B,'-3!' 

. DC. B 

'R.A. 

- ',$1B,'“32+' 

RPTMSG9: 

• DC. B 

$1B,’=4!' 

. DC. B 

'DEC. 

- ',$1B,>-42+' 

RPTMSGA: 

. DC. B 

$1B,'=5!• 

. DC. B 

'MAGNITUDE * ',$1B, 

EXPMSG: 

. DC. B 

$1B,'-5!' 

. DC. B 

'EXPOSURE TIME * • $1B, 

ERRMSG: 

. DC. B 

$1B,'*6!' 

. DC. B 

•ERROR, 

SO SORRY! ',$1B, 

.EVEN 



FCB1: 

. DC. B 

3,'HALLAVGOPIC',( 

. DC. B 

0,0,0 


FCB2: 

. DC. B 

2,'HELEN PIC',< 

. DC. B 

0,0,0 


DECIMAL: 

. DC. B 

'**********i 

MARK1: 

. DC. B 

'*♦♦' ♦MARKER 

. BSS 



.EVEN 



EXPOSURE: 

.DS.W 1 

♦STORES CCD E 


■ 12 +' 


■52+ * 


LOGDATA: 

TIMEDATA: 

WCOLORS: 

DMA: 

STARDO 

CUSVALL: 

CUSVALR: 

CUSVALH: 

CUSVALV: 

CUSVH: 

CUSW: 

X: 

Y: 

FRAMEX: 

FRAMEY: 

BIGX: 

BIG: 
BADMAP: 
SORTDATA: 
VMAX: 

HMAX: 

VMIN: 

HMIN: 


.DS.W 

.DS.B 

.DS.B 

.DS.B 

.DS.L 

.DS.W 

.DS.W 

.DS.W 

.DS.W 

.DS.W 

.DS.W 

.DS.W 

.DS.W 

.DS.W 

.DS.W 

.DS.L 

.DS.W 

.DS.L 

.DS.W 

.DS.W 

.DS.W 

.DS.W 

.DS.W 


4096 

$20 

$400 

$80 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

$1000 

$1000 

$1000 

$1000 

$1000 

$1000 


♦DMA BUFFER FOR DISK ACCESS 

♦LEFT CURSOR HISTOGRAMS 
♦RIGHT CURSOR HISTOGRAMS 
♦HORIZONTAL VECTRIX CURSOR 
♦VERTICAL VECTRIX CURSOR 
♦HORIZONTAL VECTRIX CURSOR 
♦VERTICAL VECTRIX CURSOR 

♦X,Y ARE SCREEN COORDINATES AT WHICH THE 
♦LINE WILL APPEAR 


♦BIG TELLS SHOW IF BIG HAS BEEN SELECTED 
♦BAD PIXEL MAP 

♦STORAGE FOR STAROUT MEDIAN FILTER 
♦MAXIMUM VERTICAL POSITIONS OF GROUPS 
♦MAXIMUM HORIZONTAL POSITIONS OF GROUPS 
♦MINIMUM VERTICAL POSITIONS OF GROUPS 
♦MINIMUM HORIZONTAL POSITIONS OF GROUPS 
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BRIGHT: 

.DS.L 

$1000 

AREA: 

.DS.L 

$1000 

EXPTIME1: 

.DS.B 

1 

EXPTIME2: 

.DS.B 

1 

EXPTIME3: 

.DS.B 

1 

EXPTIME4: 

.DS.B 

1 

HORTIME: 

.DS.B 

1 

VERTIME: 

.DS.B 

1 

ADTIME: 

.DS.B 

1 

BIT: 

.DS.B 

1 

BITPLANE: 

.DS.B 

1 

BYTE: 

.DS.B 

1 

BLOCKS: 

.DS.B 

1 

PAGE: 

.DS.B 

1 

RED: 

.DS.B 

1 

GREEN: 

.DS.B 

1 

BLUE: 

.DS.B 

1 

.EVEN 



HISTDATA: 

.DS.L 

$100 

WRLINE: 

.DS.L 

1 

STRBYTES: 

.DS.B 

256 

STARDATA: 

.DS.B 

$200 

BLANKl: 

.DS.B 

$400 

PAGE1: 

.DS.B 

$32600 

BLANK2: 

.DS.B 

$400 

PAGE2: 

.DS.B 

$32600 

BLANK3: 

.DS.B 

$400 

PAGE3: 

.DS.B 

$32600 

BLANK4: 

.DS.B 

$400 

PAGE4: 

.DS.B 

$32600 

BLANK5: 

.DS.B 

$400 

.END 




♦INTEGRATED BRIGHTNESS'S OF GROUPS 
♦INTEGRATED AREAS OF GROUPS 
♦CCD EXPOSURE TIME 


♦WILL NOT EXCEED 7 IF BITPLANE < 9 
♦MUST NOT EXCEED 8 

♦COUNTER FOR BYTES WITHIN THE BLOCK 
♦COUNTER FOR BLOCKS WITHIN A LINE 
♦POINTS AT WHICH PAGE TO USE 


♦PAGE BUFFER OFFSET POINTS TO LINE 
♦STORAGE FOR SORTING ROUTINE 


NLP.C accompanies "Natural Language Processing in C" by Herbert Schildt, 
BYTE, December 1987, page 269. 


/♦ NLP.C (4-8) ♦/ 

/* Recursive descent NLP Example */ 

/* Be sure to end all input with a period ♦/ 

#include "stdio.h" 

#define MAX 100 

#define NOUN 1 
#define VERB 2 
fldefine ADJ 3 
#define ADV 4 
#define DET 5 
^define PREP 6 
fldefine TERM 7 

/♦ structure of the word database */ 
struct word ( 
char word(20); 
char type; 

In¬ 
struct word wdb(MAX); /♦ array of db structures */ 

int db_pos«0; /♦ number of entries in wdb */ 

char s[80); /♦ holds the sentence */ 

char *t_pos=0; /♦ points into the sentence ♦/ 

char token(80); /* contains the word ♦/ 

main() 

( 


setup(); 

printf("Enter Sentence: "); 
gets(s); 
t_pos=s; 

if(parse()) printf("Sentence OK\n"); 
else printf("Error in sentence\n"); 


setup() 

< 
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assertwdb("door”,NOUN); 
assert_wdb("window",NOUN); 
assertwdb("house",NOUN)? 
assert_wdb("child",NOUN); 
assert_wdb("has",VERB); 
assert_wdb("runs",VERB); 
assert_wdb("plays",VERB) ; 
assertwdb("large",ADJ); 
assert_wdb("quickly",ADV); 
assertwdb("the",DET)? 
assert_wdb("a",DET); 
assertwdb("to",PREP); 
assertwdb(".",TERM)? 


/* place facts into database */ 
assertwdb(word,type) 
char *word; 
int type; 

( 


if(db_pos<MAX) ( 

strcpy(wdb[db_pos).word,word)? 
wdb(dbpos j.type=type; 
db_pos++; 

) 

else printf("Word database full.\n"); 


/* Context-free recursive descent NLP parser */ 
parse() 

( 


if(!nounphrase()) return 0? 
if(!verbphrase()) return 0? 
if(!terminator()) return 0; 
return 1; 

) 

/* read a noun phrase from the input stream */ 
nounphrase() 

( 

char type; 

gettoken(); 

type=find_type(token)? 
switch(type) { 
case DET: 

gettoken(); 
type=find_type(token); 
if(type==NOUN) return 1; 
else if(type==ADJ) ( 
get_token(); 
type=find_type(token); 
if(type==NOUN) return 1; 

) 

break; 
case PREP: 

return nounphrase(); 
return 0; 

) 

/* read a verb phrase */ 
verbphrase() 

{ 

char type,*pos; 
get_token(); 
type=find_type(token); 

if(type!=VERB) return 0; /* must start with a verb */ 

pos=t_pos; /* save current position for backtracking */ 

/* verb + adverb + NP */ 
if(verb_adv_np()) return 1; 

/* verb +NP */ 
t_pos»pos? /* back up +/ 
if(verb_np()) return 1; 
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/* verb+adverb — no NP */ 
t__pos=pos ? 

if(verb_adv()) return 1? 

/* just verb */ 

return 1? /* error in verb phrase */ 


verb_np() 

( 

/* verb + NP */ 
return nounphrase(); 


verb_adv_np() 

{ 

char type; 

gettoken(); 
type=find_type(token)? 

if(type==ADV && nounphrase()) return 1; 
return 0? 


verb_adv() 

( 

char type? 

get_token(); 

type=findtype(token); 

return (type==ADV)? 

) 

terminator() 

( 

gettoken()? 

return(find_type(token)==TERM)? 


/* find the type given the word */ 

findtype(word) 

char *word? 

( 

int t? 

for(t=0; t<db_pos? t++) 

if(!strcmp(word,wdb[t].word)) 
return wdb[t).type ? 
return 0? 


/* return a token from the input stream */ 
get_token() 

( 

char *p? 
p=token ? 

/* skip spaces */ 
while(*t_pos®«’ ') t__pos++ ? 

if (*t_pos—•. •) { 

*p++«'.•? 

*P“*\o * ? 
return ? 

) 

/* read word until a space or period */ 

while(*t_pos!-» * && *t_pos!■’.*) ( ♦ 

*p«*t_pos++ ? 

P++? 

) 

*P=* , \o»? 


NLPRPT.C accompanies ’’Natural Language Processing in C” by Herbert Schildt, 
BYTE, December 1987, page 269. 


/* NLPRPT.C (4-10) */ 
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/* Recursive descent NLP Example that reports the phrases */ 
/* Be sure to end all input with a period */ 

#include "stdio.h" 

^define MAX 100 

#define NOUN 1 
^define VERB 2 
#define ADJ 3 
#define ADV 4 
Udefine DET 5 
fdefine PREP 6 
#define TERM 7 

/* structure of the word database */ 
struct word ( 
char word[20]; 
char type; 

In¬ 


struct word wdb[MAX]? /* array of db structures */ 

int db_pos=0? /* number of entries in wdb */ 

char s[80]; /* holds the sentence */ 

char *t_pos=0; /* points into the sentence */ 

char token[80]; /* contains the word */ 

main() 

( 


setup(); 

printf ("Enter Sentence: '*) ; 
gets(s)? 
tpos=s; 

if(parse()) printf("Sentence OK\n"); 
else printf("Error in sentence\n"); 


setup() 

{ 

assert_wdb("door", NOUN) ; 
assert_wdb("window", NOUN) ; 
assert_wdb("house", NOUN) ? 
assert wdb("child", NOUN) ? 
assert_wdb("has",VERB); 
assertwdb("runs",VERB)? 
assert_wdb("plays",VERB); 
assertwdb("large",ADJ); 
assert_wdb("quickly",ADV)? 
assert_wdb("the",DET); 
assertwdb("a",DET); 
assert_wdb("to",PREP); 
assert_wdb(".",TERM)? 


/* place facts into database */ 
assert_wdb(word,type) 
char *word; 
int type; 

( 


if(db_pos<MAX) { 

strcpy(wdb(db_pos].word,word); 
wdb[db_pos].type=type; 
db_pos++; 

) 

else printf("Word database full.\n"); 


/* Context-free recursive descent NLP parser 
that displays phrases */ 
parse() 

{ 

char noun[80], verb[80]? 

noun[ 0 ]»'\ 0 *; verb( 0 )« , \ 0 *; 
if(!nounphrase(noun)) return 0; 
if(!verbphrase(verb)) return 0; 
if(!terminator()) return 0 ; 
printf("noun phrase: %s\n",noun); 


continued 
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printf( M verb phrase: %s\n M ,verb); 
return 1; 


) 

/* read a noun phrase from the input stream */ 
nounphrase(s) 
char *s; 

{ 

char type; 

gettoken(); 

type=find_type(token)? 
switch(type) { 
case DET: 

strcat(s,token); 
strcat(s," ") ; 
get_token(); 
type=findtype(token); 
strcat(s,token); 
strcat(s, M ») ; 
if(type==NOUN) return 1; 
else if(type==ADJ) ( 
gettoken(); 
strcat(s,token); 
strcat(s, M '*) ; 
type=find_type(token); 
if(type==NOUN) return 1? 

) 

break; 
case PREP: 

strcat(s,token); 
strcat(s,*» '•) ; 
return nounphrase(s); 

) 

return 0; 


/* read a verb phrase */ 
verbphrase(s) 
char *s; 

( 

char type,*pos, temp[80]; 
get_token(); 
type=find_type(token); 

if(type!«=VERB) return 0; /* must start with a verb */ 

strcat(s,token); 
strcat(s," '*) ; 

strcpy(temp,s); /* save for backtracking */ 

pos=t_pos; /* save current position for backtracking */ 

/* verb + adverb + NP */ 
if (verb_adv__np (s)) return 1; 

/* verb +NP */ 
t_pos-pos; /* back up */ 

strcpy(s,temp); 
if(verbnp(s)) return 1; 

/* verb+adverb — no NP */ 
t__pos*pos; 
strcpy(s,temp); 
if(verbadv(s)) return 1; 

/* just verb */ 

^ return 1; /* error in verb phrase */ 

verbnp(s) 
char *s; 

( 

/* verb + NP V 
return nounphrase(s); 


verbadvnp(s) 
char *s; 

( 

char type, temp[80); 

gettoken(); 
type-findtype(token); 
strcat(s,token); 
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strcat(s," "); 
temp[0]=•\0•; 

if(type==ADV && nounphrase(temp)) ( 
strcat(s,temp); 
return 1; 

) 

return 0? 


verbadv(s) 
char *s? 

{ 

char type; 

gettoken(); 
type=find_type(token); 
strcat(s,token); 
strcat(s, H "); 

return (type==ADV)? 

) 

terminator() 

( 

get_token(); 

return(find_type(token)==TERM); 


/* find the type given the word */ 
find_type(word) 
char *word; 

( 

int t; 

for(t=0? t<db_pos; t++) 

if(!strcmp(word,wdb[t).word)) 
return wdb[t).type ? 

return 0; 


/* return a token from the input stream */ 
get_token() 

( 

char *p? 
p=token? 

/* skip spaces */ 

while(*t_pos*== • *) t_pos++? 

if (*t_pos==-'. ') ( 

*p++-*.•; 

*p-*\0•; 

return; 

) 

space or period */ 
*t_pos! ** 1 . ') ( 


1 \ 0 •; 

) 


/* read word until a 
while(*t_pos!«* * && 
*p=*t_pos++? 

pt+; 
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EXKEY.BAT is from "Better Batch Files Through Assembler”, by 
William J. Claff, BYTE, IBM Special Issue, 1987, page 159. 


EXKEY.BAT 

ECHO OFF 
:prompt 
CLS 

ECHO Press 1 for program A 

ECHO Press 2 for program B 

ECHO Press Esc to exit to DOS 
igetkey 
key 

IF ERRORLEVEL 49 IF NOT ERRORLEVEL 50 GOTO a 

IF ERRORLEVEL 50 IF NOT ERRORLEVEL 51 GOTO b 

IF ERRORLEVEL 27 IF NOT ERRORLEVEL 28 GOTO exit 

GOTO getkey 
:a 

ECHO Execute program A 
PAUSE 

GOTO prompt 
:b 

ECHO Execute program B 
PAUSE 

GOTO prompt 
:exit 


INSERT.ASM is from "Pipes and Filters", by Paul Baker, BYTE, IBM 
Special Issue, 1987, page 215. 


INSERT.ASM 

IN MICROSOFT MACRO ASSEMBLER SOURCE CODE 
PURPOSE: 

Insert data or blank columns into a text file. Not only 
string data, but the carriage return [CR], line feed [LF], 
and/or form feed [FF] characters can be inserted. Can be 
used with the pipe or redirection function. 

SYNTAX: INSERT /n/ (C'data string">] [CR] [FF] [LF] / 

Where n *= column or character position to start the 
insert (255 max). CR - carriage return, LF - line feed, 
and FF = form feed. 

EXAMPLE: INSERT /1/"NEW DATA"CRLF/ 

Would insert the words NEW DATA and then a carriage return 
and line feed at the beginning of each line of the input 
file. The result would be that NEW DATA would be 
inserted between each line of the input file. 


EXAMPLE: INSERT /9/CRLF/ < OLDDATA.TXT > NEWDATA.TXT 

Would insert CR and LF at position 9 on each line of the 
file OLDDATA.TXT and store it in a file named NEWDATA.TXT. 


? <c> 

DEC. 1986 

PAUL BAKER 

CLEVELAND 

TN 


dosint 

PAGE , 
MACRO 

132 

function 

; call 

the DOS 

interrupt 


MOV 

AH,function 

? put 

function 

number in AH 


I NT 
ENDM 

21h 
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code 

STRT: 


not zero: 


getstrt: 


get insert: 


no_quotes: 


bad_param: 


leave: IRET 

cr: 

If: 

ff: 

put_insert: 


SEGMENT byte public * code' 


ORG 

PUSH 

SUB 

PUSH 

MOV 

MOV 

CLD 

XOR 

MOV 

MOV 

LODSB 

MOV 

CMP 

JNZ 

MOV 

PUSH 

POP 

dosint 

IRET 

CMP 

JB 

INC 

LODSB 

CMP 

JNE 

SUB 

MOV 

LODSB 

DEC 

CMP 

JZ 

CMP 

JBE 


CS:CODE,DS 

:DATA,SS:STACK 

0100H 


DS 

? DO HOUSEKEEPING TO 

AX, AX 

;ALLOW RETURN TO DOS 

AX 


AX,DATA 


ES, AX 

? set ES to top of data seg. 

CX,CX 

; clear CX 

BX, CX 

? clear BX 

SI,0080h 

; point to PSP 


; find how many params 

CL, AL 

; CL has count of params 

CL,OOh 

; if no params then show 

not_zero 

; use instructions. 

DX,OFFSET 

use_msg 

ES 


DS 

; get local data segment. 

09h 

; display help screen. 


; return to DOS. 

CL,07h 

; 7 is min. tt of params. 

bad param 

? if < 7 then error. 

SI 

; skip first space 


; see if / is present 

AL, 2Fh 


bad param 

? if no / then error. 

CX,0002h 

? adjust param count. 


DI,OFFSET strtdata ; set to top of buffer, 

load next param. 


CX 

AL,2Fh 
get_insert 
CX,OOOOh 


CMP 

AL,30h 


JB 

bad param 


CMP 

AL,39h 


JG 

bad param 


INC 

BL 


CMP 

BL,03h 


JG 

bad param 


SUB 

AL,30h 


CALL 

store_byte 


JMP 

get strt 


MOV 

DI,OFFSET insert 

CMP 

BL,OOh 


JLE 

bad_param 


MOV 

BH,OOh 


LODSB 

DEC 

CX 


CMP 

AL,22h 


JZ 

in quotes 


CMP 

AL, 2Fh 


JZ 

bad param 


MOV 

AH, AL 


LODSB 

DEC 

CX 


CALL 

caps 


CMP 

AX,4352h 


JZ 

cr 


CMP 

AX,4C46h 


JZ 

If 


CMP 

AX,4646h 


JZ 

ff 


JMP 

bad param 


MOV 

DX,OFFSET errl 


MOV 

CX,2Fh 


MOV 

BX,0002h 


PUSH 

ES 


POP 

DS 


dosint 

4 Oh 


MOV 

; RETURN TO DOS 
AL,ODh 


JMP 

put insert 


MOV 

AL,OAh 


JMP 

put insert 


MOV 

AL,OCh 

; 

CALL 

store byte 

f 

INC 

BH 

t 

LODSB 



CMP 

AL, 2Fh 

; 

JZ 

process 

; 

CMP 

AL,22h 

? 


if / then must be end 
of first parameter 

if last param then leave, 
if not a number between 
0 & 9 then exit 
and give error 
message. 

bump digit count, 
three digits max. 
if more than 3 then error, 
convert to binary, 
store each digit, 
get next param 
data ; load top of buffer 
if no first param then 
send error message. 

BH will count insert bytes, 
get next param. 
reduce param count, 
in quotes ? 

if so then go process, 
if another / then 
invalid parameter, 
move low byte to high byte 
load next byte, 
reduce param count, 
force upper case, 
if CR. 

if LF. 

if FF. 

else must be error, 
point to error message 
send 47 bytes, 
send to error output. 

get new data segment 
display it 

load CR byte. 

load LF byte. 

load FF byte. 

store insert info. 

bump insert byte count. 

get next param. 

if / then must be end 

of parameters. 

if quotes then 
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JZ 

in_quotes 

in_quotes: 

JMP 

no_quotes 

LODSB 



CMP 

AL,22h 


JNE 

LODSB 

inquotesl 


CMP 

AL, 2Fh 


JZ 

process 

inquotesl: 

JMP 

no quotes 

CMP 

AL, 2Fh 


JZ 

bad_param 


CALL 

store byte 


INC 

BH 


JMP 

1n_quotes 

# ___ 


INCOMING DATA 

process: 


PUSH 

ES 


POP 

DS 


MOV 

insert len,BH 


MOV 

digit cnt,BL 


MOV 

AX,Olh 


XOR 

CX,CX 

loopl: 

MOV 

CL,digit cnt 

MUL 

multlO 


LOOP 

loopl 


MOV 

BX, AX 


MOV 

CL,digit cnt 

loop2: 

MOV 

SI,OFFSET strt 

MOV 

AX, BX 


DIV 

multlO 


MOV 

AH,OOh 


MOV 

BX, AX 


MUL 

BYTE PTR [SI] 


ADD 

strt col,AL 


INC 

SI 

get_ready: 

LOOP 

loop2 

XOR 

BX, BX 


dosint 

45h 


MOV 

BP,AX 


dosint 

3Eh 

• 

MOV 

BX,0002h 

i 

dosint 

45h 

read_data: 

CLD 



MOV 

DX,OFFSET data 


MOV 

CX,800h 


MOV 

BX, BP 


dosint 

3Fh 


OR 

AX, AX 


JNZ 

more data 

nodata: 

IRET 


moredata: 

MOV 

CX, AX 


MOV 

SI, DX 

get_byte: 

MOV 

BL,strt col 


CMP 

BL,col_cnt 


JNZ 

nohit 


CALL 

make_insert 

no_hit: LODSB 

? get f 


CMP 

AL, lAh 


JZ 

no data 


CMP 

AL,ODh 


JNZ 

no_cr 


MOV 

col cnt,Olh 


MOV 

DL, AL 


dosint 

02h 


DEC 

CX 


JMP 

no hit 

no_cr: 

CMP 

AL, 09h 


JNZ 

no tab 


CALL 

tab 

notab: 

JMP 

get byte 

CMP 

AL,lFh 

send_byte: 

JBE 

no_count 

INC 

col cnt 

no_count: 

MOV 

DL, AL 


dosint 

02h 


DEC 

CX 

go_back: 

JCXZ 

read_data 


JMP 

IRET 

get_byte 


is in quotes again, 
else loop back. 

if " then out of quotes, 
if not " then go on. 
else get next after ". 
if / then must be end 


if / then must be error 
since no closing ". 
store current byte, 
bump insert byte count, 
loop back. 


; load local data pointer. 

? store insert length. 

; store digit count. 

; start AX @ 1 
; clear CX register. 

; load loop count. 

; multiply by 10 
? create multiplier 
; save multiplier. 

; load loop count, 
data ; point to l»st digit 

; get multiplier. 

S 

; clear remainder. 

; update multiplier. 

? multiply current digit. 

; update start col #. 

; bump pointer. 

; load handle 00 
? get file duplicate. 

? set base pointer to handle. 

; close file. 

# 

? file duplicate. 

buf ; store in databuf 

; set to read 800h bytes. 

? set BX to file handle. 

; read input data. 

? data read ? 


; CX has count of bytes read. 
t point to top of data. 

; see if this is 
; where the insert goes. 

; if not, then no hit. 

? else make insert. 

Lrst byte. 

; if end of file, quit. 

? cr ? 

? if not, go on. 

? else reset column count. 

; send the CR 

? reduce byte count. 

; get next byte. 

; check for tab. 

? if so, call tab routin. 

; loop back. 

? do not count anything 
? else below 20h. 

; bump column count. 

; send byte to disply. 
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MAKE INSERT ROUTINE 


make_insert: 

CMP 

insert_len,Olh 

9 


JB 

exit insert 

9 


PUSH 

CX 

• 


PUSH 

SI 

1 


MOV 

SI,OFFSET insert < 


XOR 

CX,CX 

• 


MOV 

CL,insertlen 

. 

insert_loop: 

LODSB 


. 


MOV 

DL,AL 



dosint 

02h 

. 


LOOP 

insert loop 



POP 

SI 

. 


POP 

CX 

. 

exit_insert: 

7 

RET 

n at Tm TMr 


tab: 

MOV 

CX,0008h 

i 


MOV 

DL,20h 


tab_loop: 

CMP 

BL,col_cnt 

t 


JNZ 

not_yet 

t 


CALL 

make insert 

• 


MOV 

DL,2Oh 

. 

not yet: 

dosint 

02h 

. 


INC 

col_cnt 

; 


LOOP 

tab_loop 

• 


RET 





DAIlTTUr 


caps: 

v#/\ro 

CMP 

AL,61h 



JB 

exit caps 

7 


CMP 

AL, 7Ah 



JG 

exit caps 



AND 

AX,5F5Fh 


exit_caps: 

RET 

C'PADP DViPP DrttTwrurs 


storebyte: 

PUSH 

DS 

9 


PUSH 

ES 



POP 

DS 

7 


STOSB 




PUSH 

DS 



POP 

ES 

9 


POP 

DS 

; j 


RET 




if nothing to insert 
then leave, 
save CX and 
and SI info, 
iata ; point to data, 
load CX with 
loop count, 
load next byte. 

send byte out. 

restore SI and 
CX data. 


expand tabs count, 
load space byte, 
time to make insert ? 

if so, then call insert, 
reload space byte, 
send byte, 
bump column count, 
loop back. 


convert to 
all caps. 


store current DS 
local data segment info, 
exchange them, 
store local data. 

restore original 
positions. 


CODE 


ENDS 


STACK SEGMENT 


stack SEGMENT STACK ‘stack' 

DB 32 DUP(?) 

stack ENDS 


DATA SEGMENT 


data 

errl 

strt_data 
strt_col 
col cnt DB 
digTt_cnt 
insert_len 
insertdata 
data buf 
multlO DB 
use_msg DB 
DB ' 


SEGMENT byte public 'DATA' 

DB 'INSERT : error - missing or invalid paramaters $ 


DB 
DB 
Olh 
DB 
DB 
DB 
DB 
OAh 

13,10,'PURPOSE 


3h 
00 

? current 

OOh 

OOh 

80h DUP(?) 

800h DUP(?) 


DUP (OOh) ; start position as entered 
column to start insert 
column count. 

# of digits in l'st param 
length of insert data string 
buffer for insert data 
. buffer for input data. 

# times 10 multiplier. 

',13,10,10 


DB 

DB 

DB 

DB 

DB 

DB 

DB 

DB 

DB 

DB 

DB 

DB 


and/or' 


Insert data or blank columns into a ' 

'text file. Not only string data, but',13,10 
* the Carriage Return [CR], Line Feed [LF] 

' Form Feed [FF] characters ',13,10 
' can be inserted. Can be used with the pipe or ' 

' re-direction function.',13,10,10 

SYNTAX : INSERT /n/ [<"data string''>] [CR] [FF] [LF] /',13,10 
10,' Where n « column or character position' 

' to start the insert. (255 max.)',13,10 

' CR - Carriage Return, LF - Line Feed and FF - Form Feed' 
13,10,10,'EXAMPLE : INSERT /1/''NEW DATA"CRLF/' , 13,10,10 
' Would insert the words NEW DATA and then a carriage' 

' return and line feed ',13,10 
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DB 

DB 

DB 

DB 

DB 

DB 

DB 

DB 

DB 

DB 

data 


at the begining of each line of the input file • 

The result would be that',13,10 

NEW DATA would be inserted between each line' 
of the input file.',10,13,10 
'EXAMPLE : INSERT /9/CRLF/ < OLDDATA.TXT > NEWDATA.TXT' 

. w °V, ld ins ert CR and LF at position 9 on each' 
line of the file OLDDATA.TXT ',13,10 
and store it in a disk file' 
named NEWDATA.TXT.',13,10,10 

<C> DEC. 1986 PAUL BAKER $' 

ENDS 

END STRT 


KEYIN.MM is from "Better Batch Files Through Assembler", by 
William J. Claff, BYTE, IBM Special Issue, 1987, page 159. 


CODE 

SEGMENT 


ASSUME 

CS:CODE 


ASSUME 

DS:CODE 


ASSUME 

ES:CODE 


ASSUME 

SS:CODE 


ORG 

00100H 

IP 

LABEL 

NEAR 


JMP 

START 

CURSOR 

DW 

? 

START 

LABEL 

NEAR 


MOV 

AH, 3 


INT 

010H 


CMP 

CX,00067H 


JNE 

NOBUG 


MOV 

CX,00607H 

NOBUG 

LABEL 

NEAR 


MOV 

CURSOR,CX 


MOV 

AH, 1 


MOV 

CX,02000H 


INT 

010H 

FLUSH 

LABEL 

NEAR 


MOV 

AH, 1 


INT 

016H 


JZ 

FLUSHED 


MOV 

AH, 0 


INT 

016H 


JMP 

FLUSH 


FLUSHED 

LABEL 

NEAR 


MOV 

AH, 0 


INT 

016H 


OR 

AL, AL 


JNZ 

REGULAR 


MOV 

AL, AH 


OR 

AL,10000000B 


JMP 

SHORT DONE 

REGULAR 

LABEL 

NEAR 


CMP 

AL,'a* 


JB 

DONE 


CMP 

AL,»z» 


JA 

DONE 


ADD 

AL,'A'-'a' 

DONE 

LABEL 

NEAR 


PUSH 

AX 


MOV 

AH, 1 


MOV 

CX,CURSOR 


INT 

010H 


POP 

AX 

EXIT 

LABEL 

NEAR 


MOV 

AH,04CH 


INT 

021H 

CODE 

ENDS 



END 

IP 


;<- ASSUMES FOR .COM FILE 


?<- REQUIRED FOR .COM FILE 
f (USED ON END STATEMENT) 


?<- GET CURSOR MODE 
;<- CHECK FOR BUG 

;<- TURN CURSOR OFF 

?<- FLUSH THE KEYBOARD BUFFER 


;<- WAIT FOR A KEYSTROKE 


;<- FUNCTION AND OTHER SPECIAL KEYS 
; TURN ON HIGH-BIT 


;<- REGULAR KEY 
? CONVERT TO UPPER-CASE 


;<- EXIT 


?<- REQUIRED FOR .COM FILE 
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MAKECOM.BAT is from M Better Batch Files Through Assembler”, by 
William J. Claff, BYTE, IBM Special Issue, 1987, page 159. 


ECHO OFF 

IF "\"%l == ”\” GOTO errorO 
IF NOT EXIST %1.asm GOTO errorl 
IF EXIST %1.obj erase %l.obj 
masm %1; 

IF ERRORLEVEL 1 GOTO error2 
IF EXIST %l.exe erase %l.exe 
link %1; 

IF ERRORLEVEL 1 GOTO error3 
erase %l.obj 

IF EXIST %l.com erase %l.com 
exe2bin %1 %l.com 
IF NOT EXIST %1.com GOTO error4 
erase %l.exe 

ECHO %1 MASMed, LINKed and EXE2BINed successfully. 
GOTO exit 
:errorO 

ECHO Usage: makecom source_asm 
GOTO exit 
:errorl 

ECHO %l.asm does not exist, 
goto EXIT 
:error2 

ECHO %1 did not MASM successfully. 

goto EXIT 

:error3 

ECHO %1 did not LINK successfully. 

goto EXIT 

:error4 

ECHO %1 did not EXE2BIN successfully. 

•.exit 


MSDRIVER.ASM is from "Application Input Drivers", by Jeremy Sagan, 
BYTE, IBM Special Issue, 1987, page 143. 


; mmmmmmmmmmmmmmmmmmmmmm CODE SEGMENT DEFN ■■ ■»■■■■ ■■■■—* 

# 

CSEG segment public para 'code* 

; Set to MICROSOFT = 0 to make mousesys sample program 
? Set to MICROSOFT a 1 to make microsoft sample program 

MICROSOFT ■ 0 


ORG 0 

ZERO LABEL WORD 

ORG lOOh ; For sample program only 


ASSUME CStCSEG, DS:CSEG, ES:NOTHING, SS:NOTHING 

START: 

JMP SAMPLECODE 

9 

; These are the available functions: 
i 

; function 0 « initialize mouse 

; function 1 - return button status 

; function 2 « return relative motion 

? function 3 « de-initialize mouse 

? function 4 «* return current serial port 

IF MICROSOFT 
INCLUDE MICROSOF.ASM 
ELSE 

INCLUDE MOUSESYS.ASM 
ENDIF 
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VIDEO 

= 

10H 

9 

MAXX 

DW 

80 

MAXY 

DW 

22 

MYX 

DW 

0 

MYY 

DW 

0 

MBSTAT 

DB 

OFFH 

CVM 

DB 

0 

9 

BUT1MES 

DB 

•Button one: $ 

BUT2MES 

DB 

'Button two: $ 

BUT3MES 

DB 

'Button three:$ 

PRESMES 

DB 

'pressed $' 

RELMES 

DB 

'released$' 

ERRMES 

DB 

'Mouse or Mouse 

9 

ERRNODEVICE: 



MOV DX,OFFSET ERRMES 

CALL PRINT 

JMP EXIT ROUTINE 


SAMPLECODE: 


PUSH 

CS 

POP 

DS 

MOV 

AH,OFH 

INT 

VIDEO 

MOV 

CVM,AL 

MOV 

BYTE PTR MAXX,AH 

SUB 

AH, AH 

INT 

VIDEO 

MOV 

DH,BYTE PTR MAXY 

SUB 

DL,DL 

PUSH 

DX 

CALL 

SET_CURSOR 

MOV 

DX,OFFSET BUT1MES 

CALL 

PRINT 

POP 

DX 

INC 

DH 

PUSH 

DX 

CALL 

SET_CURSOR 

MOV 

DX,OFFSET BUT2MES 

CALL 

PRINT 

POP 

DX 

INC 

DH 

CALL 

SET_CURSOR 

MOV 

DX,OFFSET BUT3MES 

CALL 

PRINT 

MOV 

BX, 4 

CALL 

ENTRY 

SUB 

BX, BX 

CALL 

ENTRY ; 

OR 

AL, AL 


SCLOOP: 


SCLOOP1: 


JZ 

MOV 

CALL 

MOV 

CWD 

IDIV 

ADO 

JNS 

MOV 

DEC 


Get current video mode 
Save current video mode 
store maximum cursor position 

Clear screen 
Row 22, column 0 


; Serial port in Ax 


ERR_NODEVICE 

BX, 2 
ENTRY 
CX, 5 

CX 

AX,MYX 
SCLOOP1 
AX,MAXX 
AX 


; scale x coordinate 

; My x cursor position 
; wrap to right 


CMP AX,MAXX 

JNG SCLOOP2 

SUB AX,AX 

SCLOOP2: 

MOV MYX,AX 

MOV AX,BX 

CWD 

IDIV CX 

ADD AX,MYY 

JNS SCLOOP25 

MOV AX,MAXY 

DEC AX 

SCLOOP25: 

CMP AX,MAXY 

JNG SCLOOP3 

SUB AX,AX 


; Wrap to left 

; Save new x 
? get delta y 

; My y cursor position 
; Wrap to bottom of screen 

? Wrap to top 


continued 
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SCL00P3: 


MOV 

MYY,AX 

MOV 

BX, 1 

CALL 

ENTRY 

CMP 

AL,MBSTAT 

JE 

SCLOOP4 

MOV 

MBSTAT,AL 

SHR 

AX, 1 

MOV 

DH,BYTE PTR MAXY 

MOV 

DL, 15 

CALL 

BUTTONPRINT 

SHR 

AX, 1 

INC 

DH 

CALL 

BUTTONPRINT 

SHR 

AX, I 

INC 

DH 

CALL 

BUTTONPRINT 

SCLOOP4: 

MOV 

DL,BYTE PTR MYX 

MOV 

DH,BYTE PTR MYY 

CALL 

SET CURSOR 

MOV 

AH, 1 

INT 

16H ; 

JZ 

SCLOOP 

SUB 

AH, AH 

INT 

16H ; 

CMP 

AL, 27 

JZ 

SCLOOP5 

MOV 

AH, 14 

INT 

VIDEO 

MOV 

AH, 3 

SUB 

BH,BH 

INT 

VIDEO 

MOV 

BYTE PTR MYX,DL 

MOV 

BYTE PTR MYY,DH 

JMP 

SCLOOP 

SCLOOP5: 

MOV 

BX, 3 

CALL 

ENTRY 

EXIT ROUTINE: 

MOV 

AL,CVM 

SUB 

AH, AH 

INT 

VIDEO 

MOV 

AX,04C00H 

INT 

MS DOS 

SET CURSOR: 

SUB 

BH, BH 

MOV 

AH, 02 

INT 

VIDEO 

RET 

BUTTONPRINT: 

PUSH 

AX 

PUSH 

DX 

PUSHF 

CALL 

SET CURSOR 

MOV 

DX,OFFSET RELMES 

POPF 

JNC 

BP2 

MOV 

DX,OFFSET PRESMES 

BP2: 

CALL 

PRINT 

POP 

DX 

POP 

AX 

RET 

PRINT: 

PUSH 

SI 

PUSH 

BX 

MOV 

SI, DX 

MOV 

BX, 3 

PRIN1: 

LODSB 

CMP 

AL, '$' 

JE 

PRIN2 

MOV 

AH, 14 

INT 

VIDEO 

JMP 

PRIN1 

PRIN2: 

POP 

BX 

POP 

SI 

RET 


Save new y 

put button 1 status in carry 


Keyboard input ? 

No 

Read key 
<Esc> ? 

Read cursor position 


Clean up after mouse 

Clear screen 
bye bye 

Set cursor position 


? Carry means button pressed 


Teletype routine 
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« 

CSEG ENDS 

9 

END START 


MICROSOFT.ASM is from "Application Input Drivers", by Jeremy 
Sagan, BYTE, IBM Special Issue, 1987, page 143. 


MSD0S EQU 21H ; Ms dos interrupt call 

MSYSCALL EQU 51 ; Microsoft system call 


This is the main entry point 

all driver routines take the function call number in BX 


function 0 ■ initialize mouse 
function 1 = return button status 
function 2 = return relative motion 
function 3 - de-initialize mouse 
function 4 * return current serial port 

Normally this would be a far procedure but to avoid getting into 
all the intricasies of loading and calling drivers I've converted 
ENTRY to a near procedure and combined it with the sample program. 


ENTRY PROC 

NEAR 

CLD 

PUSH 

DS 

PUSH 

CS 

POP 

DS 

SHL 

BX, 1 

CALL 

ROUTINES[BX] 

POP 

DS 

RET 

ENTRY ENDP 

i 

DB 

'Microsoft', 

MOUSEF DB 

0 

7 

ROUTINES LABEL 

WORD 

DW 

ISERIAL 

DW 

BUTTONSTAT 

DW 

MOTIONCOUNT 

DW 

DSERIAL 

DW 

GSERIAL 

DW 

RETADR 

DW 

RETADR 

DW 

# 

RETADR 

7 

BUTTONSTAT: 

SUB 

AX, AX 

TEST 

MOUSEF,OFFH 

JZ 

BSTAT2 

MOV 

AX, 5 

SUB 

BX, BX 

Int 

MSYSCALL 

SUB 

AH, AH 


BSTAT2: 
? 


? for Microsoft mouse the exit 


? go in the forward direction 
? save callers segment 
? make this segment addressable 

? point to routine 
; and call it through table 
? restore users segment 
? return far to caller 


7 name 


; function 0 = initialize mouse 
; function 1 ■ return button status 
? function 2 * return relative motion 
7 function 3 ■ de-initialize mouse 
7 function 4 ■ return current serial port 

? function 5 = reserved 

? function 6 — reserved 

7 function 7 - reserved 


? if no mouse then return zero 


? Read button press info 
? make ax contain press info 


routine does nothing 


DSERIAL: 

RETADR: 


RET 


? This routine returns delta mouse movement 
7 Ax ** delta x 

7 Bx ■* delta y 

7 

MOTIONCOUNT: 

SUB AX,AX 

MOV BX,AX 

TEST MOUSEF,OFFH 

JZ MC0UNT2 


continued 
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PUSH 

DX 



PUSH 

CX 



MOV 

AX, 11 



INT 

MSYSCALL 



MOV 

AX, CX 

? place into appropriate 


MOV 

BX, DX 

? registers 


POP 

CX 



POP 

DX 


MC0UNT2! 





RET 



GSERIAL: 

SUB 

AX, AX 

? No serial port needed 


RET 


? for Microsoft Mouse 

ISERIAL 

PROC 

NEAR 



PUSH 

ES 



PUSH 

BX 



MOV 

AX,03500h+MSYSCALL ? 35h » get INTerrupt vector 


INT 

MS DOS 

; returns in ES:BX 


MOV 

AX, ES 



OR 

AX, BX 

; Does interupt point at 0:0? 


MOV 

AX, 0 

; if it does then 


POP 

BX 

; Mouse software is not loaded 


POP 

ES 

; and therefore cannot be called 


JZ 

SER2 

; to do initialization. 


INT 

MSYSCALL 


SER2: 

MOV 

MOUSEF,AL 



RET 


? returns al non 0 if mouse exists 

ISERIAL 

ENDP 




MSYSMOUSE.ASM is from H Application Input Drivers'*, by Jeremy 
Sagan, BYTE, IBM Special Issue, 1987, page 143. 


ASSUME CSlCSEG, DSlCSEG, ES:NOTHING, SS:NOTHING 


SERIAL EQU 14H 

MSDOS EQU 21H 


This is the main entry point 

all driver routines take the function call number in BX 


function 0 = initialize mouse 
function 1 « return button status 
function 2 « return relative motion 
function 3 - de-initialize mouse 
function 4 « return current serial port 


Normally this would be a far procedure but to avoid getting into 
all the intricasies of loading and calling drivers I've converted 
ENTRY to a near procedure and combined it with the sample program. 


ENTRY 


ENTRY 


PROC 

NEAR 




CLD 


; 

go in the forward direction 

PUSH 

DS 

# 

save callers 

segment 

PUSH 

CS 


make this segment addressable 

POP 

DS 




SHL 

BX, 1 

; 

point to routine 

CALL 

ROUTINES[BX] 

# 

and call it through table 

POP 

DS 

; 

restore users segment 

RET 


; 

return far to caller 

ENDP 





DB 

'Mouse systems' 

,00 ; name 


! LABEL 

WORD 




DW 

ISERIAL 

; 

function 0 - 

initialize mouse 

DW 

BUTTONSTAT 

• 

i 

function 1 = 

return button status 

DW 

MOTIONCOUNT 

; 

function 2 - 

return relative motion 

DW 

DSERIAL 

; 

function 3 - 

de-initialize mouse 

DW 

GSERIAL 

; 

function 4 - 

return current serial port 

DW 

RETADR 

» 

function 5 ■ 

reserved 

DW 

RETADR 

S 

function 6 - 

reserved 

DW 

RETADR 

; 

function 7 * 

reserved 
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COMNUM 

DW 

00 

NEWX 

DW 

00 

NEWY 

DW 

00 

XACCUM 

DW 

0 

YACCUM 

DW 

0 

BSTAT 

DB 

07H 

CPORT 

DW 

03F8H 

PCOUNT 

DB 

0 

IMSK 

DB 

0EFH 


; com# 

? New x coordinate 
; New y coordinate 
; Old x coordinate 
; Old y coordinate 
; button status byte 
; communications port address 
; packet counter 
; interrupt mask 

This is the heart of the code. 

The serial interrupt handler. This code catches serial bytes and maintains 
a running total of delta x and delta y values. 


ISR: 


STI 


PUSH 

AX 

PUSH 

BX 

PUSH 

DX 

PUSH 

DS 

PUSH 

CS 

POP 

DS 

MOV 

DX,CPORT 

ADD 

DX, 5 

IN 

AL, DX 

MOV 

AH, AL 

SUB 

DX, 5 

IN 

AL, DX 

AND 

AH,01EH 

JNZ 

ISR3 


Ints back on 

Save all registers used 


make Code SEGment addressable 

get port address 

Status 

Read status 

Save in Ah 

back to data port address 
get byte from port 
mask error bits of status 
jmp if error 


Jump if an error has occured on the serial line! most likely an overrun 
error caused by interrupts cleared for long periods of time. 

This will be handled simply by clearing the packet counter. 


ISR2: 



CMP 

PCOUNT,0 


JNE 

ISR25 


MOV 

AH, AL 


AND 

AH,0F8H 


CMP 

AH,080H 


JNZ 

ISR4 


MOV 

BSTAT,AL 

ISR25: 


MOV 

BL,PCOUNT 


INC 

PCOUNT 


OR 

BL, BL 


JZ 

ISR4 

i 

CBW 



TEST 

BL, 1 


JZ 

ADDY 


ADD 

XACCUM,AX 


JMP 

SHORT ISR29 

ADDY: 


ADD 

YACCUM,AX 

ISR29: 


CMP 

BL, 4 


JB 

ISR4 

ISR3: 


MOV 

PCOUNT.0 

ISR4: 


CLI 

MOV 

AL,020H 


OUT 

020H,AL 


POP 

DS 


POP 

DX 


POP 

BX 


POP 

AX 


IRET 


; This 

table 

maps button val 


Is this the first byte of packet ? 
no so accumulate. 

it is the first byte so check certain 
bits to se if we're in sync with the 
data stream. If we're not then 
we'll just return 

we are in sync so stuff button status byte 

get packet counter 

increment for next serial interrupt 

if it's zero we're done 


; Convert delta byte to delta word 
i Check if odd or even, odd = x values 
; even « y values 
? add to running x accumulator 


? or add to running y accumulator 

; end of packet 
; no 


; yes, so reset packet counter 
? must issue EOI 


; Restore registers 
: and return from interrupt 


BUTMAP DB 


07,03,05,01,06,02,04,00 


? This routine returns button status ■ ax 
? a 1 bit indicates button presses 


continued 
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BUTTONSTAT: 

PUSH BX 

MOV AL,BSTAT 

AND AX,7 

MOV BX,OFFSET BUTMAP ? convert to Microsoft format 

XLAT 

POP BX 

RETADR: 

RET 


Motion Count routine 
on entry: 

Ax=cursor x,Bx=cursor y (Ignored by this driver) 
on exit: 


; Ax=delta x, 

P Bx=delta y 


MOTIONCOUNT: 

CALL 

QREADPACKET 

? Read a packet 

MOV 

BX,NEWY 

? return y coordinates 

NEG 

BX 

? positive coordinate move down the screen 

MOV 

RET 

AX,NEWX 

? return x 


clean up the serial port interrupts and masks 
DSERIAL: 


CLI 



IN 

AL,021H J 

: Read interupt mask 

MOV 

AH,IMSK j 

r clear appropriate int 

NOT 

AH j 

: by setting bits 

OR 

AL, AH 


OUT 

021H,AL 

write it out 

MOV 

DX,CPORT 

get port address 

ADD 

DX, 3 

line control register 

IN 

AL, DX 

fetch it 

AND 

AL,07FH 

set low to access interrupt 

OUT 

DX, AL 

enable register 

SUB 

DX, 2 

point at interrupt enable register 

SUB 

AL, AL 

clear 

OUT 

DX, AL 

it 

ADD 

DX, 3 

and clear 

OUT 

DX, AL 

modem control register 

STI 


finished 

RET 



MOV 

AX,COMNUM i 

; returns com# 

INC 

AX 


RET 




GSERIAL: 


This code intializes the mouse systems serial mouse 
it takes the com number in Ax (1 = coml 2 ■* com2) 


PROC 

NEAR 


PUSH 

CX 


DEC 

AX 


MOV 

COMNUM,AX 

? Save com# 

MOV 

DX, AX 


MOV 

AX,087H 

? 12K BAUD 

INT 

SERIAL 

? let bios initialize baucl rate and stuf 

PUSH 

BX 


PUSH 

DX 


PUSH 

CS 


MOV 

AX,04 OH 

? point at bios data segment 

MOV 

DS, AX 


MOV 

BX, DX 


SHL 

BX, 1 


MOV 

DX,ZERO[BX] 

7 Get port address at 40:0 or 40:2 

POP 

DS 


MOV 

CLI 

CPORT,DX 

7 save it 

MOV 

DX,OFFSET ISR 

? stick the serial interrupt handler 

MOV 

AL,00CH 

7 in either Int OCh, or OBh 

MOV 

AH,BYTE PTR COMNUM 


AND 

AH, 1 

? only 2 Interrupts available 

SUB 

AL, AH 


MOV 

AH,025H 

7 set interrupt request 

INT 

MS DOS 


IN 

AL,021H 

? mask the interrup controller 

MOV 

AH,OEFH 

CMP 

COMNUM,0 


JZ 

ISERIAL2 


MOV 

AH,0F7H 
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ISERIAL2: 

MOV IMSK,AH 

AND AL, AH 

OUT 021H,AL 


MOV DX,CPORT 

ADD DX,3 

IN AL,DX 

AND AL,07FH 

OUT DX,AL 

JMP $+2 

SUB DX,2 

MOV AL,1 

OUT DX,AL 

ADD DX,3 

MOV AL,08 

OUT DX,AL 

STI 

MOV DX,CPORT 

IN AL,DX 

POP DX 

POP BX 

POP CX 

MOV AL, -1 

RET 

ISERIAL ENDP 


? Save for later 


; get port address 
; Line control register 

? make interrupt enable register 
? Addressable 

; Point at it 

; set the data available int 

? Modem control register 
; set it 


; Clear receive buffer 


; mouse available. 


# 

QREADPACKET: 
QR1: 


QREXIT: 


CLI 

NOP 

MOV AX,XACCUM 

MOV NEWX,AX 

MOV AX,YACCUM 

MOV NEWY,AX 

SUB BX,BX 

MOV XACCUM,BX 

MOV YACCUM,BX 

STI 

RET 


get x accumulator 
move to new delta x 
get y 
to new y 

clear 

accumulators 


ONEKEY.ASM is from "Better Batch Files Through Assembler", by 
William J. Claff, BYTE, IBM Special Issue, 1987, page 159. 


;■■■■■■ 

=DUMMY SEGMENTS 

ENV 

SEGMENT 

AT OFFFFH 

STRINGS 

DB 

? 

ENV 

ENDS 


MEM 

SEGMENT 

AT OFFFFH 

MEMTYPE 

DB 

? 

MEMID 

DW 

? 

MEMSIZE 

DW 

? 

MEM 

ENDS 


PSP 

SEGMENT 

AT OFFFFH 


ORG 

0002CH 

ENVSEG 

DW 

? 

PSP 

ENDS 


t =*==£=* 

*CODE SEGMENT 

CODE 

SEGMENT 



ASSUME 

CS:CODE 


ASSUME 

DS:CODE 


ASSUME 

ES:CODE 


ASSUME 

SS:CODE 


ORG 

00016H 

CMDSEG 

DW 

? 


ORG 

00100H 

IP 

LABEL 

NEAR 


JMP 

START 

CURSOR 

DW 

? 

START 

LABEL 

NEAR 


■TURN CURSOR OFF 
MOV AH,3 


;<- THE ENVIRONMENT 

?<- A MEMORY BLOCK 

;<- COMMAND.COM 

?<“ ENVIRONMENT SEGMENT 

?<- ASSUMES FOR .COM FILE 

?<- COMMAND.COM SEGMENT 

;<- REQUIRED FOR .COM FILE 
; (USED ON END STATEMENT) 

;<- GET CURSOR MODE 


continued 
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INT 

010H 



CMP 

CX,00067H 

?<- CHECK FOR BUG 


JNE 

NOBUG 



MOV 

CX,00607H 


NOBUG 

LABEL 

NEAR 



MOV 

CURSOR,CX 



MOV 

AH, 1 

;<- TURN CURSOR OFF 


MOV 

CX,02000H 



INT 

010H 


t 

-LOCATE 

ENVIRONMENT 



MOV 

DX,CMDSEG 

;<- LET DS=COMMAND.COM SEGMENT 


MOV 

DS,DX 



ASSUME 

DS:PSP 



MOV 

AX,ENVSEG 

?<- CHECK ENVIRONMENT SEGMENT 


OR 

AX, AX 



JNZ 

HAVEIT 



MOV 

AX, DS 

?<- ROOT COMMAND.COM 


DEC 

AX 

; WALK MEMORY BLOCKS FORWARD 


MOV 

DS, AX 

; TO THE ENVIRONMENT 


ASSUME 

DS:MEM 


NEXTSEG 

LABEL 

NEAR 



CMP 

MEMTYPE,'M' 



JNE 

ERROR1 

?<- !ERROR! SHOULD NOT OCCUR 


MOV 

AX, DS 



INC 

AX 



ADD 

AX,MEMSIZE 



MOV 

DS, AX 



ASSUME 

DS:MEM 



CMP 

MEMID,DX 



JNE 

NEXTSEG 



MOV 

AX, DS 



INC 

AX 


HAVEIT 

LABEL 

NEAR 


i 

-LOCATE 

K=* IN THE ENVIRONMENT 


MOV 

ES, AX 



ASSUME 

ES:ENV 



XOR 

AL, AL 



MOV 

CX,08000H 



XOR 

DI,DI 


SEARCH 

LABEL 

NEAR 



REPNE 

SCAS STRINGS 



CMP 

STRINGS[DI],AL 



JE 

ERROR2 

?<- !ERROR! K= MISSING 


CMP 

STRINGS[DI],'K' 



JNE 

SEARCH 



CMP 

STRINGS[DI][1], ' 

> = » 


JNE 

SEARCH 



ADD 

DI, 2 

?<- POSITION AFTER « SIGN 

?- 

-GET KEYSTROKE. RESTRICT 

TO ASCII ! THROUGH - 

FLUSH 

LABEL 

NEAR 

?<- FLUSH THE KEYBOARD BUFFER 


MOV 

AH, 1 



INT 

016H 



JZ 

FLUSHED 



MOV 

AH , 0 



INT 

016H 



JMP 

FLUSH 


FLUSHED 

LABEL 

NEAR 


GETKEY 

LABEL 

NEAR 



MOV 

AH , 0 

;<- WAIT FOR A KEYSTROKE 


INT 

016H 



OR 

AL, AL 



JZ 

GETKEY 



CMP 

AL, • ! ' 



JB 

GETKEY 



CMP 

AL, 



JA 

GETKEY 


REGULAR 

LABEL 

NEAR 

;<- REGULAR KEY 


CMP 

AL,'a* 

; CONVERT TO UPPER-CASE 


JB 

STORE 



CMP 

AL,*z» 



JA 

STORE 



ADD 

AL,'A'-'a' 


STORE 

LABEL 

NEAR 



MOV 

STRINGS[DI],AL 

?<- STORE IN THE ENVIRONMENT 


MOV 

AH, 1 

?<- RESTORE CURSOR 


MOV 

CX,CURSOR 



INT 

010H 


9 

MOV 

AL, 0 


EXIT 

LABEL 

NEAR 

;<- EXIT 


MOV 

AH,04CH 



INT 

021H 


ERROR1 

LABEL 

NEAR 

?<- COULD NOT LOCATE ENVIRONMENT 


MOV 

AL, 1 



JMP 

EXIT 
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ERROR2 

LABEL 

NEAR 


MOV 

AL, 2 


JMP 

EXIT 

CODE 

ENDS 



END 

IP 


/<- K- MISSING FROM ENVIRONMENT 


/<- REQUIRED FOR .COM FILE 


PAL6821.LST is from "Three nun Interface Designs for the PC", by 
James R. Drummond, BYTE, IBM Spocial Issue, 1987, page 225. 


PAL16R4 

PAL FOR 6821 TO PC BUS INTERFACE J.R. DRUMMOND 24/1/87 
CONTROLS BUS ACCESS 

CLK /BS /IOR /IOW RESET PING PIN7 PIN8 PIN9 GND 

/OC RESB SELB E C PIN16 CS RWB READY VCC 


IF (VCC) 

IF (VCC) 

IF (/SELB) 
IF (VCC) 


/SELB = BS * IOR + BS * IOW 
/RESB « RESET 
/READY « /CS + CS * /C 


CS * C * E * IOW 


/RWB 

/CS 

/C 

/E 


- IOW 


5 = /CS * /C 4- /CS * E 

+ C * /E * /BS + /CS * C * /E * /IOR * /IOW 

+ CS * C * /E * /IOW 

/C * /E + /CS * C * /E 

+ CS * C * /E * /BS + CS * C * /E * /IOW 

:« C * /E -t /CS * C * E 

+ CS * C * E * /BS + CS * C * E * /IOR 


DESCRIPTION 


CLK 

1-1 


|-20 

i 

VCC 

/BS 

1 

2-| 


|-19 

i 

READY 

/IOR 

1 

3-1 


|-18 

i 

RWB 

/IOW 

1 

4—j 

1 


1 

R | -17 

CS 

RESET 

1 

5-| 

1 

16R4 

1 

R | -16 
| 

PIN16 

PIN6 

6-| 

■ 


R | -15 

C 

PIN7 

7-| 


1 

R | -14 

E 

PIN8 

8-| 

I 


1 

|-13 

1 

SELB 

PIN9 

9-| 


1 

|-12 

1 

RESB 

GND 

10-| 


|-11 

/OC 

CS C 

E 



0 1 

1 




0 1 

0 




1 

! + /IOR./IOW 



1 

BS.IOW 


<--- 

<-+ 

0 |BS.IOW 
-+ 


- + 

I 

BS.IOR 

10 0 
10 1 

<~*■ 

111 |BS.IOR 
-+ 
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0 0 0 
0 0 1 


NO ACCESS 


WRITE CYCLE 


READY ASSERTED AT LOOP POINT IN BOTH CYCLES AND BEYOND 


READ CYCLE 


PAL810.LST is from "Three Bus Interface Designs for the PC", by 
James R. Drummond, BYTE, IBM Special Issue, 1987, page 225. 


PAL16R6 

PAL FOR NSC810 TO PC BUS INTERFACE J.R. DRUMMOND 4/2/87 
CONTROLS BUS ACCESS 

CLK /BS /IOR /IOW RESET A4 A3 A2 A1 GND 

/OC SELB ADENB ALE RDB WkB DATENB RES READY VCC 


IF (VCC) /SELB = BS * /A4 * IOR + BS * /A3 * IOR 

+ BS * A4 * A3 * /A2 * /A1 * IOR 

+ BS * /A4 * IOW + BS * /A3 * IOW 

+ BS * A4 * A3 * /A2 * /A1 * IOW 

IF (/SELB) /READY « RDB * /WRB * /ALE + DATENB * /RDB * WRB * /ALE 
+ DATENB * RDB * WRB * /SELB 

/RES :« /RESET 

/ADENB DATENB * RDB * WRB * ALE 

+ ADENB * DATENB * RDB * WRB * /ALE 


/ALE := /DATENB + /WRB + /RDB 

+ /ADENB * DATENB * RDB * WRB * /SELB 

/RDB := /ADENB * DATENB * RDB * WRB * /ALE * /SELB * IOR 

+ /RDB * WRB * /ALE * /SELB * IOR 

/WRB := /ADENB * DATENB * RDB * WRB * /ALE * /SELB * IOW 

+ ADENB * DATENB * RDB * /WRB * /ALE * /SELB * IOW 

/DATENB :*= RDB * /WRB * /ALE 

+ /DATENB * RDB * WRB * /ALE * /SELB * IOW 
+ /RDB * WRB * /ALE * /SELB * IOR 


DESCRIPTION 


•U 


CLK 

1-1 


|-20 

1 

VCC 

/BS 

1 

2“| 


1 

|-19 

i 

READY 

/IOR 

1 

3-1 


R | -18 
■ 

RES 

/IOW 

1 

4-1 

i 


1 

R | -17 

i 

DATENB 

RESET 

1 

5-| 

1 

16R6 

1 

R | -16 

1 

WRB 

A4 

6-| 


R | -15 

RDB 

A3 

1 

7-1 


1 

R | -14 

ALE 

A2 

1 

8-| 

1 


R | -13 

I 

ADENB 

A1 

1 

9-j 

j 


1 

|-12 

1 

SELB 

GND 

10-| 


1 

|-11 

/OC 


ADEN DATEN RD WR /ALE 
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+-> 

1 

1 

0 

0 

1 

0 

0 






1 

1 

1 




1 

1 

1 

BS 

* low I BS * IOR 






1 

1 

I 

1 

0 

0 

1 

4" 

0 

1 










1 








1 

1 




1 

1 

1 

BS 

.low 




1 

1 

BS.IOR 

1 

0 

0 

0 

1 

1 

1 

0 

0 

1 

1 

0 1 

1 

1 

0 

1 

0 

1 

1 

1 




1 

1 


1 

1 

1 

1 

0 

1 

0 

1 

1 

4-- 

0 

1 <-4* MM * low 

1 

0 

1 

1 

1 

1 

V 

O 

1 

1 




1 

4-~ 






4-- 

1 


1 

1 




1 








1 

1 

1 

0 

0 

0 

1 

1 

0 

1 






1 

4-— 




1 









WRITE CYCLE READ CYCLE 

READY ASSERTED AT LOOP POINT IN IIOTII CYCLES AND BEYOND 
ADDRESSES 00000 -> 11001 ARE DECOI)i:i> 


PMODE.ASM is from "286/386 Prol ocl Programming”, by Joel 

Barnum, BYTE Special Issue, 1907, page 125. 


PAGE ,132 
TITLE PMODE 

COMMENT @ 

These procedures allow a protected mode program to avoid certain 
protection exceptions. 

NOTES: 1# These procedures Intended to run in protected mode 

on a 286 or 386-banad computer. Any attempt to execute 
them in real mode, oi on an 8088-based PC will most likely 
result in a system crash I 

2. This file was assembled using Microsoft's MASM Version 4.0 


• 286p 

CODE SEGMENT PUBLIC 'CODE' 
ASSUME CS:CODE 


/enable protected mode instructions 


; check__segment_limit: Determine it an offset is usable within a segment 

• INPUT: BX - scloctor fot the segment 

• CX - offset to chock 

• OUTPUT: CF: 0 - selectorioffnet is OK 

; 1 - oxcoptlon will occur if selector:offset used 


checksegmentlimit PROC 

PUBLIC check sngmant 1imit 


PUSH DX 

LSL DX,BX 

JNZ exception return 

CMP CX,DX 

JA exception return 

CLC 

JMP SHORT csl_exit 

exception_return: 

STC 

csl_exit: 

POP DX 

RET 


/obtain the segment's limit 
/oxit if bad selector 
/compare offset and limit 
/jump if offset above limit 
/iioloctor:offset OK 
/return to caller 

/bad noloctor or offset 


check_segment_limit ENDP 
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check_sensitive: Determine if we can execute sensitive instructions 

INPUT: None 

OUTPUT: CF: 0 - sensitive instructions OK at current privilege 
1 - exception will occur if we attempt a sensitive 
instruction 


check_sensitive PROC 

PUBLIC checksensitive 

PUSH AX 
PUSH BX 


PUSHF 


POP 

AX 

AND 

AX,3000H 

SHR 

AX, 12 

MOV 

BX, CS 

AND 

BX, 3 

CMP 

BX, AX 

JA 

no sensitive 

CLC 


JMP 

SHORT csexit 

sensitive: 


STC 


exit: 


POP 

BX 

POP 

AX 

RET 



;save flags (IOPL). on stack 
;copy flags to AX 
;mask all but IOPL 
;right-justify IOPL 
;CPL resides in CS 
;mask all but CPL 
/compare CPL and IOPL 
?jump if CPL > IOPL 
/sensitive instructions OK 


/exception occurs on sensitive 


check_sensitive ENDP 


check_privileged: Determine if we can execute privileged instructions 
INPUT: None 

OUTPUT: CF: 0 - privileged instructions OK at current privilege 
1 - exception will occur if we attempt a privileged 
instruction 


check_privileged PROC 

PUBLIC checkprivileged 


PUSH 

AX 


MOV 

AX, CS 

/CPL resides in CS 

AND 

AX, 3 

/mask all but CPL 

JNZ 

nojprivileged 

/jump if CPL <> 0 

CLC 


/privileged instructions OK 

JMP 

SHORT epexit 

no privileged: 



STC 

cp exit: 


/exception occurs on privileged 

POP 

RET 

AX 


check_privileged ENDP 

CODE ENDS 

END 



SPY.C is from "Spying on Windows", by Mike Geary, BYTE, IBM 
Special Issue, 1987, page 97. 


* Spy.c * * 

* Windows Spy Program * 

* Public Domain * 

* Written by Michael Geary * 

* * 

* This program "spies" on all the windows that are currently open in your * 

* Windows session, and displays a window containing all the information it * 

* can find out about those windows. You can scroll through this window * 

* using either the mouse or keyboard to view the information about the * 

* various windows. The "New Spy Mission" menu item re-captures the latest * 

* information. This menu item is on the System menu so you can trigger it * 

* even if the Spy window is iconic. * 

\* - -- -- -- -- -- -- -- -- - - 

#define LINT ARGS 
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#include <windows.h- 
#include <stdio.h> 

#include "spy.h" 


/* 


V 


/* The display for a nIngle window looks like this in collapsed mode: 

* (Child|Popup|TopLov#1 ) window HHHH (class) (L,T?R,B) "title” 

* or like this in expanded mode? 

* 

* {Child|Popup|Topl,ov« 1 ) window handle: HHHH 

* Class namo: (clmm name) 

* Window title: (thin tnxt) 

* Parent window hand I • liillill 

* Class function, window function: HHHH:HHHH, HHHH:HHHH 

* Class modulo hand In, Window instance handle: HHHH, HHHH 

* Class extra alloo, Window oxtra alloc: DDDDD, DDDDD 

* Class stylo, Window nlyln: HHHH, HHHHHHHH 

* Menu handle: HHHH 01 Control ID: DDDDD 

* Brush, Cursor, Iron Imndlou: HHHH, HHHH, HHHH 

* Window rectangle: l.d! • DDDDD, Top=DDDDD, Right=DDDDD, Bottom=DDDDD 

* Client rectanglo: I. fl h|)|)|)D, Top=DDDDD, Right=DDDDD, Bottom=DDDDD 

* (blank line) 

* 

* Total number of linou foi one window display: 13 


^define LINES_PER_WINDOW I I 

^define WINDOW_WIDTH i ,*o 


/* The INFO structure contalim .»| | th*' information we gather up about each 

* window we are spying on. Wo allocate an array of INFO structures in the 

* global heap, with ono on!iy foi naoh window in the system. 

V 

Udefine CLASSMAX 30 
#define TITLEMAX 50 


typedef struct ( 

HWND winHWnd? /* 

char winClass(CLASSMAX]? 

HBRUSH winBkgdBrush? 

HCURSOR winCursor; /* 

HICON winlcon; /* 

HANDLE winClassModule; /* 

WORD winWndExtra? /* 

WORD winClsExtra; /* 

WORD winClassStyle? 

FARPROC winClassProc? /* 

HANDLE winlnstance; /* 

HWND winHWnd Pa rent; /* 

char winTitle(TITLEMAX); /* 

WORD winControlID? /* 

FARPROC winWndProc; /*> 

DWORD winStyle; /* 

RECT winWindowRect; /* 

RECT winClientRect; /* 

) INFO? 


Window handle */ 

Class name */ 

he kground brush handle */ 
cut nor handle */ 
ir«»n handle */ 

Modulo handle for owner of class */ 

Exi t.! data allocated for each window */ 
Extra data allocated in class itself */ 
Clrturi style word */ 

Window function declared for class */ 
Inrdance handle for window owner */ 
Parent window handle */ 

Window title or content string */ 
conirol ID or menu handle */ 

Window function, usually *= class fun. */ 
Stylo doubleword for window (WS__...) */ 
Window rectangle (screen-relative) */ 
cl Ient rectangle within window rect. */ 


typedef HANDLE HINFO? /* Handle to array of INFO structures */ 

typedef INFO huge * LPINFO? /* Fai pointer to same when locked down */ 


/* T ^ e CsrScroll array is used for implementing keyboard scrolling. By 

* looking up the keystroke in this array, wn get the equivalent scroll 

* bar message. 

*/ 


^define VK_MIN_CURSOR VK_PRIOR 
#define VK_MAX_CURSOR VK DOWN 


struct ( 

char csBar; /* Which scroll bar thin key in equivalent to */ 

char csMsg; /* The scroll meeaago for this key */ 

) CsrScroll(] - ( 

( SBVERT, SB_PAGEUP ), /* VK_PRIOR (PgUp) */ 

( SB VERT, SB_PAGEDOWN ), /* VK_NEXT (PgDn) */ 

( SB_VERT, SB_BOTTOM ), /* VK_END (End) */ 


continued 
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{ SB_VERT, SB_TOP }, 
{ SB_HORZ, SB_LINEUP }, 
{ SB_VERT, SB__LINEUP } # 
{ SBHORZ, SB_LINEDOWN ), 
{ SBVERT, SB_LINEDOWN } 


/* VK_HOME (Home) */ 
/* VK_LEFT (left arrow) */ 
/* VKUP (up arrow) */ 
/* VK_RIGHT (right arrow) */ 
/* VK__DOWN (down arrow) */ 


/* 


/* Static variables 

V 


HANDLE 

hlnstance? 

HINFO 

hlnfo? 

LPINFO 

lplnfo? 

int 

nWindows? 

DWORD 

dwInfoSize? 

FARPROC 

IpprocCountWindow ? 

FARPROC 

1pprocSpyOnWindow? 

BOOL 

blnitted «= FALSE? 

BOOL 

bExpand * FALSE? 

int 

nLinesPerWindow *= 

int 

nCharSizeX? 

int 

nCharSizeY? 

int 

nExtLeading? 

int 

nPaintX? 

int 

nPaintY? 

HDC 

hdcPaint? 

char 

szciass[10]? 

char 

szTitle[40)? 

/* -- 


/* Declare 

full templates for 


/* Our instance handle */ 

/* Global handle to INFO array structure */ 
/* Far pointer to INFO, when locked down */ 
/* Total number of windows in system */ 

/* Size of entire INFO array in bytes */ 
Proclnstance for CountWindow */ 
Proclnstance for SpyOnWindow */ 

TRUE when initialization completed */ 

/* Expanded display mode? */ 

/* 1 or LINESPERWINDOW */ 

/* Width of a character in pixels */ 

/* Height of a character in pixels */ 

/* # pixels vertical space between chars */ 
For Paint function: X coordinate */ 

For Paint function: Y coordinate */ 

For Paint function: hDC to paint into */ 
/* Our window class name */ 

/* Our window title */ 


/* 

/* 

/* 


/* 

/* 

/ 


V 


our functions. This gives us strong type 


*/ 

BOOL 

FAR 

PASCAL 

int 

void 

BOOL 

void 


cdecl 

void 

void 

void 

BOOL 

BOOL 

FAR 

PASCAL 

long 

FAR 

PASCAL 

int 


PASCAL 


CountWindow( HWND, long ); 

DoScrollMsg( HWND, int, WORD, int )? 
HomeScrollBars( HWND, BOOL ); 

Initialize( HANDLE, int )? 

Paint( char *, ... ) ; 

PaintWindow( HWND ); 

SetScrollBars( HWND ); 

SetScrollBarl( HWND, int, int )? 
SpyOnAllWindows( HWND ); 

SpyOnWindow( HWND, long )? 

SpyWndProc( HWND, unsigned, WORD, LONG ) 
WinMain( HANDLE, HANDLE, LPSTR, int )? 


V 


t* Enumeration function to count the number of windows in the system. Called 
r/ or ea ch window, via EnumWindows and recursively via EnumChildWindows. 


V 


The lTopLevel parameter tells us which kind of call it is. 


BOOL FAR PASCAL CountWindow( hWnd, lTopLevel ) 

HWND hWnd; /* window handle for this window */ 

long lTopLevel? /* l-top level window, 0»child window */ 


/* Count the window */ 
dwInfoSize +« sizeof(INFO)? 
++nWindows; 


/* If this is a top level window (or popup), count its children */ 
if( lTopLevel ) EnumChildWindows( hWnd, IpprocCountWindow, OL )? 

return TRUE? /* TRUE to continue enumeration */ 


V 


......-.V 

Process a scroll bar message. Calculates the distance to scroll based on 
the scroll bar range and the message code. Limits the scroll to the actual 
range of the scroll bar. Sets the new scroll bar thumb position and 
scrolls the window by the necessary amount. Note that the scroll bar 
ranges are set in terms of number of characters, while the window scrolling 
is done by a number of pixels. Returns the distance scrolled in chars. 


int DoScrollMsg( hWnd, nBar, wCode, 
HWND hWnd ? 

int nBar? 

WORD wCode ? 

int nThumb? 


nThumb ) 

/* Window handle to scroll */ 

/* Which scroll bar: SBHORZ or SB VERT */ 
/* The scroll bar message code */ 

/* Thumb position for SBTHUMBPOSITION */ 
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( 


int 

nOld; 

/* 

int 

nDirr? 

/* 

int 

nMin; 

/* 

int 

nMax? 

/* 

int 

nPagofi 1 / *. / 

/* 

RECT 

rect; 

/* 


Previous scroll bar position */ 
Amount to change scroll bar by */ 
Minimum value of scroll bar range */ 
Maximum value of scroll bar range */ 
Size of our window in characters */ 
Client rectangle for our window */ 


/* Get old scroll j.it Inn u, i iicroll range */ 

nOld = GetScrol 1 Pun ( hWn*t, niut )? 
GetScrollRango( IiWimI # nh u , jii»Min, &nMax ); 


/* Quit if there In iiuwlmi. k roll to (see SetScrollBars) */ 

if ( nMax — MAXI NT ) i nt uni <>/ 


/* Calculate page nli-n, lim i ntni or vertical as needed */ 

GetClientRect( hWnd, ni.nl ) 

if( nBar == SB__HORZ ) n!'<«• j* i (rect.right - rect.left) / nCharSizeX; 

else nP.»'|. i n ■ (rect.bottom - rect.top) / nCharSizeY; 

/* Select the amount tu m 11 < i i l>y, based on the scroll message */ 
switch( wCode ) ( 


case SBLINEUP: 
nDiff - -1/ 
break? 


case SBJLINEDOWN: 
nDiff - 1; 
break? 


case SBPAGEUP: 

nDiff « -nPngu:; I . • , 
break? 


case SBPAGEDOWN: 

nDiff - nPagaSisa; 
break? 


case SBJTHUMBP0SIT1ON 

nDiff = nThumb noM 
break? 

case SBTOP: 

nDiff « -30000? l' 1 ltd of n kludge but it works... */ 

break? 

case SBBOTTOM: 

nDiff - 30000/ 
break? 


) 


default: 

return 0? 


/* Limit scroll destination to i.mi., nMa */ 
if( nDiff < nMin - nOld ) nDiff nMin noid? 

if( nDiff > nMax - nOld ) nDiff nM <\* nOld? 


if( nDiff 0 ) return 0/ /* P«»turn li not effect is nothing */ 


/* OK, now we can set tho now *.. I l•.». position and scroll the window */ 

SetScrollPos( hWnd, nBar, nohl ♦ nD iff# TRUE )? 


ScrollWindow( 

hWnd, 

nBar «« sb_horz ? *nDiff*n0harflii«X I 0, 
nBar — SB__HORZ ? 0 : nl)l f l *n« b,u ■; 1 /nY, 

NULL, 

NULL 


/* Force an immediate updatn Cm • I- m- • .«pp< nance */ 
UpdateWindow( hWnd )? 


return nDiff? 

) 


/* Set both scroll bars to tho homo posit tun (0) 


continued 
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void HomeScrollBars( hWnd, bRedraw ) 

HWND hWnd; /* window handle */ 

( BOOL bRedraw; /* TRUE if scroll bars should be redrawn */ 

SetScrollPos( hWnd, SB_HORZ, 0, bRedraw )? 

SetScrollPos( hWnd, SB_VERT, 0, bRedraw ); 


/* Initialize the application. Some of the initialization is different 

* depending on whether this is the first instance or a subsequent instance. 

* For example, we register our window class only in the first instance. 

* Returns TRUE if initialization succeeded, FALSE if failed. 

V 


BOOL Initialize( hPrevInst, nCmdShow ) 


HANDLE hPrevInst? /* 

int nCmdShow? /* 

WNDCLASS Class? /* 

HWND hWnd ? /* 

HDC hDC? /* 

TEXTMETRIC Metrics? /* 

HMENU hMenu; /* 

int nScreenX? 

int nScreenY? 


Previous instance handle, 0 if first */ 
Parameter from WinMain for ShowWindow */ 

Class structure for RegisterClass */ 

Our window handle */ 

Display context for our window */ 

Text metrics for System font */ 

Menu handle of system menu */ 


nScreenX = GetSystemMetrics( SMCXSCREEN ); 
nScreenY - GetSystemMetrics( SM_CYSCREEN )? 


if( ! hPrevInst ) ( 

/* Initialization for first instance only */ 


/* Load strings from resource file */ 
Loadstring( hlnstance, IDSCLASS, szClass, 

Loadstring( hlnstance, IDSJTITLE, szTitle, 


sizeof(szClass) )? 
sizeof(szTitle) )? 


/* Register our window 
Class.style = 

Class.lpfnWndProc 
Class.cbClsExtra - 
Class.cbWndExtra ■ 
Class.hlnstance = 

Class.hlcon - 

Class.hCursor = 

Class.hbrBackground « 
Class.IpszMenuName 
Class.IpszClassName = 


class */ 

CS_HREDRAW | CS_VREDRAW? 
SpyWndProc? 

0 ? 

0 ? 

hlnstance? 

LoadIcon( hlnstance, szClass )? 

LoadCursor( NULL, IDC_ARROW ); 

COLORWINDOW + 1? 

szClass; 

szClass? 


if( i RegisterClass( &Class ) ) return FALSE? 


) else ( 

/* Initialization for subsequent instances only */ 

/* Copy data from previous instance */ 

GetlnstanceData( hPrevInst, szClass, sizeof(szClass) ); 

GetlnstanceData( hPrevInst, szTitle, sizeof(szTitle) ); 


/* Initialization for every instance */ 

/* Set U P Proclnstance pointers for our Enumerate functions */ 
IpprocCountWindow = MakeProcInstance( CountWindow, hlnstance )? 
IpprocSpyOnWindow = MakeProcInstance( SpyOnWindow, hlnstance )? 
if( ! IpprocCountWindow || ! IpprocSpyOnWindow ) return FALSE; 

/* Allocate our INFO structure with nothing really allocated yet */ 
hlnfo = GlobalAlloc( GMEMMOVEABLE, 1L )? 
if( ! hlnfo ) return FALSE; 


/* Create our tiled window but don't display it yet */ 
hWnd « CreateWindow( 


szClass, 

szTitle, 

WS_TILEDWINDOW | WS_HSCROLL 
nScreenX * 1/20, 


nScreenY * 
nScreenX * 
nScreenY * 
NULL, 

NULL, 

hlnstance, 

NULL 


10 , 

10 , 

10 , 


/* Class name */ 

/* Window title */ 

| WS_VSCROLL, /* Window style */ 

/* X: 5% from left */ 

/* Y 10% from top */ 

/* nWidth: 90% */ 

/* nHeight: 70% */ 

/* Parent hWnd (none for top-level) */ 
/* Menu handle */ 

/* Owning instance handle */ 

/* Parameter to pass in WMCREATE (none) 
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) ? 

/* Initialize scroll bars - Windows doesn't do this for us */ 
HomeScrollBars( hWnd, FALSE )? 

/* Calculate character size for system font */ 
hDC « GetDC( hWnd ); 

GetTextMetrics( hDC, SMetrics )? 

ReleaseDC( hWnd, hDC )? 

nExtLeading = Metrics.tmExternalLeading; 

nCharSizeX - Metrics.tmMaxCharWidth? 

nCharSizeY *= Metrics.tmHeight + Metrics.tmExternalLeading? 

/* Make the window visible before grabbing spy info, so it's included */ 
ShowWindow( hWnd, nCmdShow )? 

/* Now grab the spy information */ 

if( 1 SpyOnAllWindows( hWnd ) ) return FALSE; 

/* Got all the information, update our display */ 

UpdateWindow( hWnd ); 

/* Make note that initialization is complete. This is checked in our 
* routine that handles WM_SIZE to eliminate some jitter on startup */ 
blnitted = TRUE; 
return TRUE; 


/* Format and paint a line of text. szFormat and Args are just as in a 

* sprintf() call (Args is a variable number of arguments). The global 

* variables nPaintX and nPaintY tell where to paint the line. We increment 

* nPaintY to the next line after painting. 

* Note the 'cdecl' declaration. This forces this function to use the 

* standard C calling sequence, which is necessary with a variable number 

* of parameters. 

V 


void cdecl Paint( szFormat, Args ) 


char * 

szFormat? 

/* 

char 

Args ? 

/* 

int 

nLength? 

/* 

char 

Buf[160]? 

/* 


Format string as used in printf() */ 

Zero or more parameters, as in printf */ 

Length of formatted string */ 

Buffer to format string into */ 


nLength *= vsprintf( Buf, szFormat, &Args ); 


TextOut( hdcPaint, nPaintX, nPaintY+nExtLeading, Buf, nLength )? 
nPaintY += nCharSizeY; 


/* Paints our window or any portion of it that needs painting. 

* The BeginPaint call sets up a structure that tells us what rectangle of the 

* window to paint, along with other information for the painting process. 

* First, erase the background area if necessary. 

* Then, calculate the index into the INFO array to start with, based on the 

* painting rectangle and the scroll bar position, and lock down the INFO. 

* Finally, loop through the INFO array, painting the text for each entry. 

* Quit when we run out of entries or hit the bottom of the paint rectangle. 


void PaintWindow( hWnd ) 


HWND 

hWnd; 

/* 

PAINTSTRUCT 

ps; 

/* 

DWORD 

rgbOldTextColor; 

/* 

DWORD 

rgbOldBkColor ? 

/* 

int 

nwin? 

/* 

int 

X? 

/* 

int 

Y? 

/* 

PSTR 

pTypeName ? 

/* 


/* Tell Windows we're painting, 
BeginPaint( hWnd, &ps ); 


Window handle to paint */ 

Paint structure set up by BeginPaint */ 
Old text color (so we can restore it) */ 
Old background color */ 

Index into INFO array */ 

X position for paint calculation */ 

Y position for paint calculation */ 
Pointer to "Child", etc. string */ 

up the paint structure. */ 


/* Store display context in global for Paint function */ 
hdcPaint « ps.hdc? 


/* Set up proper background and text colors and save old values */ 
rgbOldBkColor - SetBkColor( ps.hdc, GetSysColor( COLOR WINDOW ) )? 
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rgbOldTextColor = SetTextColor( ps.hdc, GetSysColor( COLORWINDOWTEXT ) ); 
/* Calculate horizontal paint position based on scroll bar position */ 

X = ( 1 - GetScrollPos( hWnd, SBHORZ ) ) * nCharSizeX; 

/* Calculate index into INFO array and vertical paint position, based on 

* scroll bar position and top of painting rectangle */ 

Y = GetScrollPos( hWnd, SB_VERT ); 

nWin = ( ps.rcPaint.top / nCharSizeY + Y ) / nLinesPerWindow; 
nPaintY = ( nWin * nLinesPerWindow - Y ) * nCharSizeY; 

/* Lock down INFO array and set lplnfo pointing to first entry to paint */ 
lplnfo = (LPINFO)GlobalLock( hlnfo ); 
lplnfo += nWin? 

/* Loop through INFO entries, painting each one until we run out of entries 

* or until we are past the bottom of the paint rectangle. We don't worry 

* much about painting outside the rectangle - Windows will clip for us. */ 
while( nWin < nWindows && nPaintY < ps.rcPaint.bottom ) 

{ 

/* Set X position and indent child windows, also set up pTypeName */ 
nPaintX «= X? 

if( lpInfo->winStyle & WS_CHILD ) ( 

nPaintX += nCharSizeX * ( bExpand ? 4 : 2 )? 
pTypeName = "Child"; 

) else if( lpInfo->winStyle & WS_ICONIC ) { 
pTypeName = "Icon "; 

) else if( lplnfo->winStyle & WSPOPUP ) ( 
pTypeName = "Popup"; 

} else { 

pTypeName = "Top Level"; 

) 

if( ! bExpand ) { 

/* Paint the one-liner */ 

Paint( 

"%s window %04X (%Fs) (%d,%d;%d,%d) \"%Fs\"", 

pTypeName, 

lpInfo->winHWnd, 

lpInfo->winClass, 

lpInfo->winWindowRect.left, 

lpInfo->winWindowRect.top, 

lpInfo->winWindowRect.right, 

lpInfo->winWindowRect.bottom, 

lpInfo->winTitle 

)? 

) else ( 

/* Paint the expanded form, first the window handle */ 

Paint( 

"%s window handle: %04X", 

pTypeName, 

lpInfo->winHWnd 

)? 


/* Paint the rest of the info, indented two spaces farther over */ 
nPaintX +« nCharSizeX * 2; 

Paint( "Class name: %Fs", lpInfo->winClass ); 

Paint( "Window title: %Fs", lpInfo->winTitle ); 

Paint( "Parent window handle: %04X", lpInfo->winHWndParent ); 

Paint( 

"Class function, Window function: %p, %p", 

lpInfo->winClassProc, 

lpInfo->winWndProc 

) * 

Paint( 

"Class module handle, Window instance handle: %04X, %04X", 

lplnfo->winClassModule, 

lpInfo->winInstance 

); 

Paint( 

"Class extra alloc, Window extra alloc: %d, %d", 
lplnfo->winClsExtra, 
lplnfo->winWndExtra 

) ? 

Paint( 

"Class style, Window style: %04X, %081X", 

lpInfo->winClassStyle, 

lplnfo->winStyle 

) * 

Paint( 

lplnfo->winStyle & WS^CHILD ? "Control ID: %d" : 

"Menu handle: %04X", 
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lpInfo->winControlID 

); 

Paint( 

"Brush, Cursor, Icon handles: %04X, %04X, %04X", 
lplnfo->winBkgdBrush, 
lpInfo->winCursor, 
lplnfo->winIcon 

); 

Paint( 

"Window rectangle: Left=%4d, Top=%4d, Right=%4d, Bottom=%4d", 

lplnfo->winWindowRect.left, 

lplnfo->winWindowRect.top, 

lplnfo->winWindowRect.right, 

lpInfo->winWindowRect.bottom 

) * 

Paint( 

"Client rectangle: Left=%4d, Top=%4d, Right«=%4d, Bottom=%4d", 

lplnfo->winClientRect.left, 

lplnfo->winClientRect.top, 

lplnfo->winClientRect.right, 

lplnfo->winClientRect.bottom 

)? 

/* Make a blank line - it*s already erased, so just increment Y */ 
nPaintY 4— nCharSizeY? 

) 

/* Increment to next INFO entry */ 

++nWin; 

++lpInfo? 

) 

/* Unlock the INFO array */ 

GlobalUnlock( hlnfo ); 

/* Restore old colors */ 

SetBkColor( ps.hdc, rgbOldBkColor )? 

SetTextColor( ps.hdc, rgbOldTextColor )? 

/* Tell Windows we're done painting */ 

EndPaint( hWnd, &ps ); 


/* Set horizontal and vertical scroll bars, based on the window size and the 

* number of INFO entries. The scroll bar ranges are set to give a total 

* width of WINDOW^WIDTH and a total height equal to the number of lines of 

* information available. For example, if there are 130 lines of information 

* and the window height is 10 characters, the vertical scroll range is set 

* to 120 (130-10). This lets you scroll through everything and still have 

* a full window of information at the bottom. (Unlike, say, Windows Write, 

* where if you scroll to the bottom you have a blank screen.) 


void SetScrollBars( hWnd ) 

HWND hWnd? 

( 

RECT rect; 

GetClientRect( hWnd, Greet ); 


/* Window handle */ 

/* The window's client rectangle */ 


SetScrollBarl( 

hWnd, SBHORZ, 

WINDOW_WIDTH - rect.right / nCharSizeX 


SetScrollBarl( 

hWnd, SB_VERT, 

nWindows * nLinesPerWindow - rect.bottom / nCharSizeY 


/* Set one scroll bar's maximum range. We always set the minimum to zero, 

* although Windows allows other values. There is one case we handle 

* specially. If you set a scroll bar range to minimum==maximum (maximum ■ 

* zero for us), Windows does not actually set the range, but instead turns 

* the scroll bar completely, changing the window style by turning off 

* the WS HSCROLL or WS_VSCROLL bit. For example, this is how the MS-DOS 

* Executive makes its scroll bars appear and disappear. This bphavior is 

* fine if you take it into account in your programming in two ways. First, 

* whenever you do a GetScrollRange you must first check the window style to 
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* see if that scroll bar still exists, because you will *not* get the correct 

* answer from GetScrollRange if it has been removed. Second, you must be 

* prepared to get some extra WM_SIZE messages, because your client area 

* changes size when the scroll bars appear and disappear. This can cause 

* some sloppy looking screen painting. We take a different approach, always 

* keeping the scroll bars visible. If the scroll bar range needs to be set 

* to zero, instead we set it to MAXINT so the bar remains visible. Then, in 

* DoScrollMessage we check for this case and return without scrolling. 

V 


void SetScrollBarl( hWnd, nBar, nMax ) 


HWND hWnd; /* 

int nBar? /* 

int nMax? /* 

( 

int nOldMin? /* 

int nOldMax? /* 


Window handle */ 

Which scroll bar: SB_HORZ or SBVERT */ 
Value to set maximum range to */ 

Previous minimum value (always 0) */ 
Previous maximum value */ 


/* Check for a negative or zero range and set our special case flag. 

* Also, set the thumb position to zero in this case. */ 
if( nMax <= 0 ) { 
nMax » MAXINT? 

DoScrollMsg( hWnd, nBar, SBTHUMBPOSITION, 0 )? 


/* Find out the previous range, and set it if it has changed */ 
GetScrollRange( hWnd, nBar, SnOldMin, fcnOldMax )? 

if( nMax nOldMax ) SetScrollRange( hWnd, nBar, 0, nMax, TRUE )? 


/* - v 

/* Loop through all windows in the system and gather up information for the 

* INFO structure for each. Use the EnumWindows and EnumChildWindows 

* functions to loop through them. We actually loop through them twice: 

* first, to simply count them so we can allocate global memory for the 

* INFO structure, and again to actually fill in the structure. After 

* gathering up the information, we invalidate our window, which will cause 

* a WMPAINT message to be posted, so it will get repainted. 

*/ 


BOOL SpyOnAllWindows( hWnd ) 

HWND hWnd; /* window handle */ 

{ 

/* Calculate the number of windows and amount of memory needed */ 
nWindows =0; 
dwInfoSize =0? 

EnumWindows( IpprocCountWindow, 1L )? 

/* Allocate the memory, complain if we couldn't get it */ 
hlnfo - GlobalReAlloc( hlnfo, dwInfoSize, GMEM MOVEABLE )? 
if( i hlnfo ) ( 
nWindows “0? 
dwInfoSize « 0? 

GlobalDiscard( hlnfo )? 

MessageBox( 

GetActiveWindow(), 

"Insufficient memory!!", 

NULL, 

MB_OK | MBICONHAND 

) ; 

PostQuitMessage( 0 )? 
return FALSE? 

) 

/* Lock down the memory and fill in the information, then unlock it */ 
lplnfo ■■ (LPINFO)GlobalLock( hlnfo ) ; 

EnumWindows( IpprocSpyOnWindow, 1L )? 

GlobalUnlock( hlnfo )? 

/* Set the scroll bars based on new window count, repaint our window */ 
SetScrollBars( hWnd )? 

HomeScrollBars( hWnd, TRUE )? 

InvalidateRect( hWnd, NULL, TRUE )? 

return TRUE? 

) 

/*..-.- . ..*/ 

/* Enumeration function to gather up the information for a single window and 

* store it in the INFO array entry pointed to by lplnfo. Increment lplnfo 

* to the next entry afterward. Called once for each window, via EnumWindows 

* for each top level and popup window, and recursively via EnumChildWindows 

* for child windows. The ITopLevel parameter tells which kind of call it is. 

V 
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BOOL FAR PASCAL SpyOnWindow( hWnd, lTopLevel ) 

HWND hWnd; /* window handle */ 

^ lon 9 lTopLevel; /* l=top level window, 0=*child window */ 

/* Gather up this window's information */ 
lpInfo->winHWnd = hWnd; 

GetClassName( hWnd, lplnfo->winClass, CLASSMAX )? 
lplnfo->winClass[ CLASSMAX - 1 ] = 0; 

lpInfo->winInstance = GetWindowWord( hWnd, GWW_HINSTANCE )? 
lplnfo->winHWndParent = GetParent( hWnd ); 

GetWindowText( hWnd, lpInfo->winTitle, TITLEMAX ); 
lplnfo->winTitle[ TITLEMAX - 1 ] = 0; 
lpInfo->winControlID = GetWindowWord( hWnd, GWW_ID ); 
lpInfo->winWndProc * (FARPROC)GetWindowLong( hWnd, GWLWNDPROC ); 
lplnfo->winStyle = GetWindowLong( hWnd, GWLSTYLE )? 

GetClientRect( hWnd, &lpInfo->winClientRect ); 

GetWindowRect( hWnd, &lpInfo->winWindowRect )? 

/* Gather up class information */ 

lplnfo->winBkgdBrush = GetClassWord( hWnd, GCW_HBRBACKGROUND ); 
lplnfo->winCursor = GetClassWord( hWnd, GCWHCURSOR )? 
lpInfo->winIcon = GetClassWord( hWnd, GCWHICON ); 
lplnfo->winClassModule = GetClassWord( hWnd, GCW HMODULE ); 
lpInfo->winWndExtra = GetClassWord( hWnd, GCW CBWNDEXTRA ); 
lpInfo->winClsExtra = GetClassWord( hWnd, GCWCBCLSEXTRA ); 
lplnfo->winClassStyle = GetClassWord( hWnd, GCWSTYLE ); 
lpInfo->winClassProc = (FARPROC)GetClassLong( hWnd, GCLWNDPROC ); 

/* Move on to next entry in table */ 

++lpInfo; 

/* it's a top level window, get its children too */ 

if( lTopLevel ) EnumChildWindows( hWnd, IpprocSpyOnWindow, 0L )? 

return TRUE; /* TRUE to continue enumeration */ 


/* Window function for our main window. All messages for our window are sent 
to this function.. For messages that we do not handle here, we call 
* DefWindowProc, which performs Windows' default processing for a message. 


long FAR PASCAL SpyWndProc( hWnd, 
HWND hWnd; 

unsigned wMsg; 

WORD wParam? 

LONG 1Param? 

{ 

RECT rect ? 


wMsg, wParam, IParam ) 

/* Window handle */ 

/* Message number */ 

/* Word parameter for the message */ 
/* Long parameter for the message */ 

/* A rectangle */ 


switch( wMsg ) { 


/* Menu command message - process the command */ 
case WM_COMMAND: 

if( LOWORD(IParam) ) break; /* not a command */ 
switch( wParam ) ( 
case CMD_EXPAND: 

bExpand « ! bExpand? 

nLinesPerWindow « ( bExpand ? LINES PER WINDOW : 1 )? 
CheckMenuItem( 

GetMenu( hWnd ), 

CMD_EXPAND, 

bExpand ? MF CHECKED ; MF UNCHECKED 

) ? 

InvalidateRect( hWnd, NULL, TRUE )? 

HomeScrollBars( hWnd, FALSE )? 

SetScrollBars( hWnd ); 
return 0L; 
case CMDJSPY: 

SpyOnAllWindows( hWnd )? 
return OL? 
default; 
break? 

) 

break? 


/* Destroy-window message - time to quit the application */ 
case WMDESTROY; 

PostQuitMessage( 0 )? 
return OL? 
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/* Horizontal scroll message - scroll the window */ 
case WMHSCROLL: 

DoScrollMsg( hWnd, SB_HORZ, wParam, (int)lParam )? 
return OL? 


/* Key-down message - handle cursor keys, ignore other keys */ 
case WM_KEYDOWN: 

if( wParam >« VK_MIN_CURSOR && wParam <- VKMAXCUR^OR ) { 
DoScrollMsg( 
hWnd, 

CsrScroll[ wParam - VK_MIN_CURSOR j.csBar, 

CsrScroll[ wParam - VK_MIN_CURSOR j.csMsg, 

0 

); 

) 

return OL; 

/* Paint message - repaint all or part of our window */ 
case WM_PAINT: 

PaintWindow( hWnd ); 
return OL; 

/* Size message - recalculate our scroll bars to take the new size 

* into account, but only if initialization has been completed. There 

* are several superfluous WM__SIZE messages sent during initialization, 

* and it looks ugly if we repaint the scroll bars for all these. */ 
case WMSIZE: 

if( blnitted ) SetScrollBars( hWnd ); 
return OL; 

/* Vertical scroll message - scroll the window */ 
case WM_VSCROLL: 

DoScrollMsg( hWnd, SBVERT, wParam, (int)lParam ); 
return OL; 

/* For all other messages, we pass them on to DefWindowProc */ 
default; 
break; 

) 

return DefWindowProc( hWnd, wMsg, wParam, IParam ); 


/* - */ 

/* Application main program. Not much is done here - we just initialize 

* the application, putting up our window, and then we go into the typical 

* message dispatching loop that every Windows application has. 


int PASCAL WinMain( hlnst, hPrevInst, IpszCmdLine, nCmdShow ) 

HANDLE hlnst; /* Our instance handle */ 

HANDLE hPrevInst; /* Previous instance of this application */ 

LPSTR IpszCmdLine; /* Pointer to any command line params */ 

int nCmdShow; /* Parameter to use for first Shov/Window V 


( 


MSG 


msg; 


/* Message structure */ 


/* Save our instance handle in static variable */ 
hlnstance « hlnst; 


/* Initialize application, quit if any errors */ 

if( ! Initialize( hPrevInst, nCmdShow ) ) return FALSE; 


/* Main message processing loop. Get each message, then translate keyboard 
* messages, and finally dispatch each message to its window function. */ 
while( GetMessage( &msg, NULL, 0, 0 ) ) { 

TranslateMessage( &msg ); 

DispatchMessagc( &msg ); 

) 


return msg.wParam; 

) 


/* 


V 


SPY.DEF is from *'Spying on Windows”, by Mike Geary, BYTE, IBM 
Special Issue, 1987, page 97. 


NAME Spy 
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DESCRIPTION 'Windows Espionage' 


STUB 'WINSTUB. 

EXE' 

CODE MOVEABLE 

DATA MOVEABLE 

MULTIPLE 

HEAPSIZE 1024 

STACKSIZE 4096 


EXPORTS 


CountWindow 

@1 

SpyOnWindow 

@2 

SpyWndProc 

§3 


SPY.RC is from "Spying on Windows", by Mike Geary, BYTE, IBM 
Special Issue, 1987, page 97. 


/*----.- - V 

/* Spy.rc - resource file for SPY.EXE */ 

/* - */ 

#include <style.h> 

#include "spy.h" 

/* -- */ 

Spy! ICON spy.ico 

/*- V 

STRINGTABLE 

BEGIN 

IDSCLASS, "Spy!" 

IDS_TITLE, "Spy on Windows!" 

END 

/*-V 

Spy! MENU 

BEGIN 

POPUP "&Spy" 

BEGIN 


MENUITEM "&New Spy Mission", CMD_SPY 
MENUITEM SEPARATOR 

MENUITEM "Show &Detail", CMD_EXPAND 

END 


END 

/ 

/* - */ 


SPY.H is from "Spying on Windows", by Mike Geary, BYTE, IBM 
Special Idsue, 1987, page 97. 


/*- V 

/* SPY.H V 

/*. V 

#define MAXINT 32767 

Udefine MAXWORD 65535 

/* - */ 


/* Menu command definitions */ 
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#define CMDSPY 1 

^define CMDEXPAND 2 

/*-v 


/* String table ID numbers */ 


^define IDS_CLASS 1 

#define IDSJTITLE 2 

/*--V 


SPY is from "Spying on Windows", by Mike Geary, BYTE, IBM 
Special Issue, 1987, page 97. 


it Makefile for SPY.EXE 

spy.obj: spy.c 

msc -AS -Gcsw -Os -u -W2 -Zdp $*? 

findwarn 

spy.res: spy.rc spy.ico 

rc -r spy.rc 

spy.exe: spy.obj spy.res spy.def 

link4 spy, spy/align:16, spy/map/line, slibw, spy.def 
mapsym4 spy 
rc spy.res 


SPY.DOC is from "Spying on Windows", by Mike Geary, BYTE, IBM 
Special Issue, 1987, page 97. 


This is the SPY program from my article "Spying on Windows" in the 1987 
IBM special issue of BYTE. 

The source code included can be compiled with either the 1.03/4 or 2.0 
Windows Software Development Kit. Although there are a few minor items 
in the SPY code that use Windows 2.0 features, nothing depends on them, 
so the source code is still compatible with the l.Ox development kit. 


When Windows 2.0 becomes generally available, I will be coming out with 
a version of SPY that uses more of the Windows 2.0 facilities to do a 
little more thorough investigation of other applications. Stay tuned! 

If you find SPY useful, drop me a note and let me know what interesting 
things you have done with it. (No, don't send money - it's a freebie!) 

Michael Geary 
P.O. Box 1479 
Los Gatos, CA 95031 

BIX: 'geary' 

GEnie: GEARY 
CompuServe: 76146,42 


STAMPER.ASM is from "TSRs Past and Future: MS-DOS and OS/2", by 
Ray Duncan, BYTE, IBM Special Issue, 1987, page 49. 


name stamper 

page 55,132 

title STAMPER: a simple keyboard monitor 

.286c 

.sail 
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STAMPER.EXE: a simple OS/2 monitor that inserts 
a date or time stamp into the keyboard data stream. 

Alt-D is the hot-key for a date-stamp. 

Alt-T is the hot-key for a time-stamp. 

Alt-X causes the STAMPER.EXE monitor to exit. 

Copyright (C) 1987 Ray Duncan 

To assemble and link this program: 

MASM stamper; 

LINK stamper,,,DOSCALLS,stamper ? 

To use this program, execute it with the command: 

C>DETACH STAMPER 


stdin 

equ 

0 

i 

standard device handles 

stdout 

equ 

1 



stderr 

equ 

2 



cr 

equ 

Odh 

• 

ASCII carriage return 

If 

equ 

Oah 

i 

ASCII line feed 




• 

Hot-key definitions: 

datekey 

equ 

2 Oh 

; 

Alt-D 

timekey 

equ 

14h 

; 

Alt-T 

exitkey 

equ 

2dh 

; 

Alt-X 


extrn 

DOSGETINFOSEG:far 

• 

OS/2 API services needed 


extrn 

DOSEXITifar 




extrn 

DOSSLEEP:far 




extrn 

DOSWRITE:far 




extrn 

DOSMONOPEN:far 




extrn 

DOSMONCLOSE:far 




extrn 

DOSMONREG:far 




extrn 

DOSMONREAD:far 




extrn 

DOSMONWRITE:far 




extrn 

VIOPOPUP:far 




extrn 

VIOENDPOPUP:far 




extrn 

VIOWRTCHARSTR:far 



jerr 

macro 

target 

• 

Macro to test return code 

local 

zero 

?. 

in AX and j'ump if non-zero 


or 

ax, ax 

; 

Uses JMP DISP16 to avoid 


jz 

zero 

? 

branch out of range errors 


jmp 

target 



zero: 

endm 





DGROUP 

group 

_DATA 



_DATA 

segment 

word public 'DATA' 



popflag 

dw 

1 

• 

wait for Popup window 

wlen 

dw 

? 

? 

receives length written 

kname 

db 

'\DEV\KBD$',0 

i 

device name of keyboard 

khandle 

dw 

0 

• 

i 

handle from DosMonOpen 

gseg 

dw 

? 

• 

global information segment 

lseg 

dw 

? 


local information segment 

scrgrp 

dw 

? 

> 

foreground screen group 

dstr 

db 

'mm/dd/yy',0 

i 

strings used by time and 

tstr 

db 

'hh:mm',0 

* 

date formatting routines 

monin 

dw 

128,64 dup (0) 

• 

buffers for monitor 

monout 

dw 

128,64 dup (0) 



packet 

db 

128 dup (0) 

! 

buffer for kbd data packet 

pktlen 

dw 

? 

S 

length of buffer prior to read 




i 

call, length of data after. 

msgl 

db 

cr,If,'Start STAMPER 

with 

DETACH!',cr,lf 


msgl_JLen equ $-msgl 

msg2 db 'STAMPER utility installed!» 

msg2_len equ $-msg2 
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msg3 

db 

'Alt-D to insert date stamp.' 

msg3_len equ 

$-msg3 

msg4 

db 

'Alt-T to insert time stamp.' 

msg4_len equ 

$-msg4 

msg5 

db 

'Alt-X to shut down STAMPER.' 

msg5_len equ 

$-msg5 

msg6 

db 

'STAMPER utility deactivated. 

msg6_len equ 

$-msg6 

msg7 

db 

cr,If,'Unexpected OS/2 error' 

msg7_len equ 

$-msg7 

DATA 

ends 



TEXT segment word public •CODE' 

assume cs: TEXT # ds:OGROUP,ss:DGROUP 


main 

proc 

far 


push 

ds 


push 

offset DGROUP:gseg 


push 

ds 


push 

offset DGROUP:lseg 


call 

DOSGETINFOSEG 


jerr 

error 


mov 

es,lseg 


mov 

ax,es:[8] 


cmp 

ax, 16 


je 

mainl 



push 

stderr 


push 

ds 


push 

offset DGROUP:msgl 


push 

msgl_len 


jmp 

error2 

mainl: 

mov 

es,gseg 


mov 

cbw 

al,byte ptr es:[0018h] 


mov 

scrgrp,ax 


push 

ds 


push 

offset DGROUP:kname 


push 

ds 


push 

offset DGROUP:khandle 


call 

DOSMONOPEN 


jerr 

error 


push 

khandle 


push 

ds 


push 

offset DGROUP:raonin 


push 

ds 


push 

offset DGROUP:monout 


push 

1 


push 

scrgrp 


call 

DOSMONREG 


jerr 

error 

main2: 

call 

signon 


mov 

pktlen,pktlen-packet 

push 

ds 

push 

offset DGROUP:monin 

push 

0 

push 

ds 

push 

offset DGROUP:packet 

push 

ds 

push 

offset DGROUP:pktlen 

call 

DOSMONREAD 


; entry point from OS/2 

; get selectors for system's 
; global information segments 


; transfer to OS/2 
; give up if can't get selectors 

; get our screen group number 
; and make sure we are detached 

; proceed, all is well 

; not run with DETACH, 

? display error message... 

? handle for standard error 
; address of message 

; length of message 
? go display and exit 

; get foreground screen group 
; from global info segment 


? open monitor connection... 

; address of name \DEV\KBD$ 

; address to receive monitor handle 

? transfer to OS/2 
? give up if can't open it 

? register as keyboard monitor... 

; handle from DosMonOpen 
; addr of monitor input buffer 

; addr of monitor output buffer 

? request front of list 
? screen group we are monitoring 
; transfer to OS/2 
? give up if can't register 

? else announce our presence 

; monitor the keyboard character 
? stream? when hot key detected, 

? insert the appropriate date or 
? time stamp, or exit. 

? set max buffer length for read 

? get next keyboard data packet 
? address of monitor input buffer 

? wait until data available 

? buffer for keyboard data packet 

; receives length of data packet 
; transfer to OS/2 
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cmp 

byte ptr packet+2,0 

? 

is this extended code? 


jnz 

main4 

7 

no, just pass it on 


cmp 

byte ptr packet+3,exitkey 



jz 

main5 

9 

jump if exit hot-key 


cmp 

byte ptr packet+3,timekey 



jnz 

main3 

9 

jump if not time hot-key 


cmp 

word ptr packet+12,0 

• 

discard break packets 


jnz 

main2 



call 

time 

9 

insert the time stamp 


jmp 

main2 

9 

discard this key 

main3: 



9 

is it datestamp hot-key? 


cmp 

byte ptr packet+3,datekey 


jnz 

main4 

• 

no, j ump 


cmp 

word ptr packet+12,0 

• 

9 

discard break packets 


jnz 

main2 



call 

date 

; 

insert the date stamp 


jmp 

main2 

? 

discard this key 

main4: 

push 

ds 

7 

Not hot-key, pass packet on. 
address of monitor output buffer 


push 

offset DGROUP:monout 



push 

ds 

; 

address of keyboard data packet 


push 

offset DGROUP:packet 



push 

pktlen 

7 

length of data packet 


call 

DOSMONWRITE 

• 

transfer to OS/2 


jmp 

main2 

9 

wait for another packet 

mainS: 



9 

hotkey for de-install detected 


cmp 

word ptr packet+12,0 

; 

make sure it's Break packet 


jz 

main2 

'• 

if not just discard it 


push 

khandle 

7 

close the monitor connection 


cali 

DOSMONCLOSE 




jerr 

error 




call 

signoff 

7 

announce STAMPER exit 


push 

1 

7 

terminate all threads 


push 

0 

7 

return success code 


call 

DOSEXIT 

» 

final exit to OS/2 

main 

endp 




error 

proc 

near 

; 

unilateral termination 




7 

because of unexpected error. 


cmp 

khandle,0 

7 

first shut down monitor 


je 

errorl 

7 

if it is active 


push 

khandle 




call 

DOSMONCLOSE 

7 

ignore any error codes 

errorls 



7 

write message 'Unexpected error' 


push 

stderr 

7 

handle for standard error device 


push 

ds 

7 

address of message 


push 

offset DGROUP:mug7 




push 

msg7_len 

7 

longth of message 

error2: 

push 

ds 

7 

ioceives bytes written 


push 

offset DGROUP:wlon 



call 

DOSWRITE 

7 

tianafor to OS/2 


push 

1 

7 

terminate all threads 


push 

1 

7 

i urn error code 


call 

DOSEXIT 

7 

fInal exit to OS/2 

error 

endp 




date 

proc 

near 

7 

foimat and insert date stamp 


mov 

es,gseg 

7 

• jnt noiactor for global 




7 

i n.ul-only information segment 


continued 
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mov 

al,byte ptr es:[llh] 

; 

convert month to ASCII 


aam 

add 

ax,'00' 




xchg 

al,ah 




mov 

word ptr dstr,ax 




mov 

al,byte ptr es:[10h] 

? 

convert day to ASCII 


aam 

add 

ax,'00* 




xchg 

al,ah 




mov 

word ptr dstr+3,ax 




mov 

ax,word ptr es:[12h] 

$ 

convert year to ASCII 


sub 

ax,1900 




aam 

add 

ax,'00' 




xchg 

al,ah 




mov 

v/ord ptr dstr+6,ax 




mov 

si,offset DGROUP:dstr 

• 

insert date stamp string 


call 

stuff 

* 

into keyboard data stream 


ret 


! 

back to caller 

date 

endp 




time 

proc 

near 

i 

format and insert time stamp 


mov 

es,gseg 

; 

get selector for global 




; 

read-only information segment 


mov 

al,byte ptr es:[8] 

; 

convert hours to ASCII 


aam 

add 

ax,*00* 




xchg 

al,ah 




mov 

word ptr tstr,ax 




mov 

al,byte ptr es:[9] 

i 

convert minutes to ASCII 


aam 

add 

ax,'00» 




xchg 

al,ah 




mov 

word ptr tstr+3,ax 




mov 

si,offset DGROUP:tstr 

i 

insert time stamp string 


call 

stuff 

i 

into keyboard data stream 


ret 


i 

back to caller 

time 

endp 




stuff 

proc 

near 

i 

insert string into keyboard 




t 

data stream. Call with 




? 

SI ■= ASCIIZ string (null 




i 

is discarded) 




! 

AL, SI destroyed. 

stuffl: 

lodsb 


• 

get next character 


or 

al,al 

• 

t 

is it null? 


jnz 

stuff2 

! 

no, use it 


ret 


i 

yes, exit 

stuff2: 

mov 

packet+2,al 

i 

place ASCII code into packet 




i 

now send this character 




i 

to the keyboard driver... 


push 

ds 

i 

address of monitor output buffer 


push 

offset DGROUPimonout 




push 

ds 

? 

address of keyboard data packet 


push 

offset DGROUP:packet 




push 

pktlen 

# 

length of data packet 


call 

DOSMONWRITE 

• 

t 

transfer to OS/2 


jmp 

stuffl 

• 

i 

do another character 

stuff 

endp 




signon 

proc 

near 

t 

i 

use pop-up window to 
display help message 


push 

ds 

? 

put up Popup window 


push 

offset DGROUP:popflag 

! 

(wait until available) 


push 

0 




call 

VIOPOPUP 
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mov 

dx,offset DGR0UP:msg2 

• 

9 

message address 


mov 

cx,msg2_len 

9 

length 


mov 

ax,9 

9 

Y coordinate 


call 

center 

; 

display it 


mov 

dx,offset DGROUP:msg3 

; 

message address 


mov 

cx,msg3_len 

9 

length 


mov 

ax, 13 

9 

Y coordinate 


call 

center 

• 

9 

display it 


mov 

dx,offset DGR0UP:msg4 

9 

message address 


mov 

cx,msg4_len 

9 

length 


mov 

ax, 15 

; 

Y coordinate 


call 

center 

9 

display it 


mov 

dx,offset DGROUP:msg5 

9 

9 

message address 


mov 

cx,msg5_len 

• 

length 


mov 

ax, 17 

• 

9 

Y coordinate 


call 

center 

9 

display it 


push 

0 

9 

pause for 3 seconds 


push 

3000 

9 

(user must be quick reader!) 


call 

DOSSLEEP 



push 

0 

9 

take down PopUp window 


call 

VIOENDPOPUP 



ret 


9 

back to caller 

signon 

endp 




signoff proc 

near 

9 

use pop-up window to 




'* 

announce exit 


push 

ds 

7 

put up PopUp window 


push 

push 

call 

offset DGROUP:popflag 
o 

7 

(wait until available) 


VIOPOPUP 




mov 

dx,offset DGROUP:msg6 

7 

message address 


mov 

cx,msg6_len 

7 

length 


mov 

ax, 12 

; 

Y coordinate 


call 

center 

! 

display it 


push 

0 

• 

pause for 1 seconds 


push 

1000 

7 

(user must not blink 


call 

DOSSLEEP 


at wrong time...) 


push 

0 

• 

take down PopUp window 


call 

VIOENDPOPUP 



ret 


7 

back to caller 

signoff 

endp 




center 

proc 

near 

. 

center a message on screen 




• 

0 

call DX « msg offset, 




7 

CX - length, AX - Y coordinate 


push 

ds 

• 

address of message 


push 

dx 



push 

cx 

7 

length of message 


push 

ax 

; 

Y 


sub 

cx, 80 

; 

X«((80-length)/2) 


neg 

CX 




shr 

cx, 1 




push 

cx 




push 

0 

7 

VIO handle 


call 

VIOWRTCHARSTR 

7 

transfer to OS/2 


ret 


7 

back to caller 

center 

endp 




_TEXT 

ends 





end 

main 




continued 
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STAMPER.DEF is from "TSRs Past and Future: MS-DOS and OS/2”, by 
Ray Duncan, BYTE, IBM Special Issue, 1987, page 49. 


The module definition file: STAMPER.DEF 


NAME STAMPER 
PROTMODE 
DATA MOVEABLE 
CODE MOVEABLE PURE 
STACKSIZE 4096 


STAMPER.MAK is from "TSRs Past and Future: MS-DOS and OS/2”, by 
Ray Duncan, BYTE, IBM Special Issue, 1987, page 49. 


The MAKE file: STAMPER 


stamper.obj : stamper.asm 
masm /Zi /T stamper? 

stamper.exe : stamper.obj stamper.def stamper 
link /CO /MAP stamper,,,doscalls,stamper 


The End! 


STRING.ASM is from "Better Batch Files Through Assembler", by 
William J. Claff, BYTE, IBM Special Issue, 1987, page 159. 


VECTOR 

STRUC 



REGIP 

DW 

? 


REGCS 

DW 

? 


VECTOR 

ENDS 



CODE 

SEGMENT 




ASSUME 

CS:CODE 

?<- ASSUMES FOR .COM FILE 


ASSUME 

DS:CODE 



ASSUME 

ES:CODE 



ASSUME 

SS:CODE 



ORG 

00100H 

?<- REQUIRED FOR .COM FILE 

IP 

LABEL 

NEAR 

? (USED ON END STATEMENT) 


JMP 

SHORT START 


HOLDS 

DB 

16 

?<- FOR DOS BUFFERED INPUT FUNCTION 

HAS 

DB 

0 


INPUT 

DB 

15 DUP(* ') ,0 


SET 

DB 

11 

?<- FOR INT 2E 


DB 

'SET STRING-' 


SETTING 

DB 

16 DUP(?) 


;*******INT 2E 

PROCEDURE 


SS SP 

VECTOR 

<> 


INT2E 

PROC 

NEAR 



PUSH 

AX 

?<- SAVE ALL REGISTERS 


PUSH 

BX 



PUSH 

CX 



PUSH 

DX 



PUSH 

BP 



PUSH 

SI 



PUSH 

DI 



PUSH 

DS 



PUSH 

ES 



PUSHF 




MOV 

SS SP.REGIP,SP 

?<- SAVE SS:SP 


MOV 

SS SP.REGCS,SS 



INT 

02EH 

;<- DO INT 2E 


ASSUME 

DS:NOTHING 
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ASSUME 

ES;NOTHING 



ASSUME 

SS:NOTHING 



MOV 

SS,SS SP.REGCS 

;<- RESTORE SS:SP 


ASSUME 

SS:CODE 



MOV 

SP,SS_SP.REGIP 



POPF 


;<- RESTORE ALL REGISTERS 


POP 

ES 



ASSUME 

ESI CODE 



POP 

DS 



ASSUME 

DS:CODE 



POP 

DI 



POP 

SI 



POP 

BP 



POP 

DX 



POP 

CX 



POP 

BX 



POP 

AX 



RET 



INT2E 

ENDP 



START 

LABEL 

NEAR 



MOV 

AH,04AH 



MOV 

BX,OFFSET FREE 



DEC 

BX 



MOV 

CL, 4 



SHR 

BX, CL 



INC 

BX 



INT 

021H 



MOV 

AH,OOCH 

;<- GET INPUT STRING 


MOV 

AL,OOAH 



MOV 

DX,OFFSET HOLDS 



INT 

021H 



XOR 

CH, CH 



MOV 

CL,HAS 



JCXZ 

ERROR1 



ADD 

SET,CL 



MOV 

SI,OFFSET INPUT 



MOV 

DI,OFFSET SETTING 


REP 

MOVSB 



XOR 

BH, BH 



MOV 

BL,SET 



MOV 

SET[BX] [1] ,001)11 



MOV 

SI,OFFSET SET 



CALL 

INT2E 


EXIT 

LABEL 

NEAR 

/<- EXIT 


MOV 

AH,04CH 



INT 

021H 


ERROR1 

LABEL 

NEAR 



MOV 

AL, 1 



JMP 

EXIT 


FREE 

LABEL 

BYTE 


CODE 

ENDS 




END 

IP 

/• REQUIRED FOR .COM FILE 


T6821.PAS is from w Thr«*« Mum I nt • • i Dosigns for the PC”, by 

James R. Drummond, BYTE, I HM rip«w Ini Issue, 1987, page 225. 


program test 6821/ 
const 

PORTLOC - $308/ 

CONTROLLOC - $»8A/ 

var 

i,j,k: integer/ 

begin 

portw[PORT_LOC] : $flll, 
port[CONTROL_IOCJ l- 
repeat 

begin 

for j i- 0 to mnxlnt do 
begin 

portw[ PORT l4>c| i* )/ 
k poi 1 w| POUT 14)(’) / 
if k • • ) I lii'ii w i 11 < in( * help * A G) ; 

end; 

end; 

writeln(k); 
until false; 

end. 


continued 
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T810.PAS is from "Three Bus Interface Designs for the PC”, by 
James R. Drummond, BYTE, IBM Special Issue, 1987, page 225. 


program test_810? 
const 


PORT LOC 

K 

$380? 

NSC 0 

= 

$000? 

MDR 

= 

$7? 

PORT AB 

= 

0? 

DDR AB 

s 

$4? 


var 

i,j,k: integer? 

begin 

portw [ PORT_LOC or NSC_0 or MDR] := 0? 

portw[P0RT_L0C or NSC_0 or DDRAB] := $ffff? 

repeat 

begin 

for j :■ 0 to maxint do 
begin 

portw[PORT_LOC or NSC_0 or PORTAB] :*= j? 
k := portw[PORTLOC or NSC_0 or PORTAB]? 
if j <> k then writeln('help* A G)? 

end? 

end? 

writeln(k)? 
until false? 

end. 


T8255.PAS is from "Three Bus Interface Designs for the PC", by 
James R. Drummond, BYTE, IBM Special Issue, 1987, page 225. 


program test_8255? 
const 

PORT_A « $388? 

P0RT_B - $389? 

P0RT_C - $38A? 

CONTROL__LOC *= $38B? 

var 

i,j,k: integer? 

begin 

port[CONTROL_L0C] $84; 

repeat 

begin 

for j :■ 0 to maxint do 
begin 

port[P0RT_A] :« 1o(j)? 
port[PORT B] :« hi(j)? 
i porttPORT_A]? 

k port [ PORT__B ] ? 

if (hi(j) <> k) or (lo(j) <> i) then writeln('help* A G); 

end? 

end? 

writeln(k:6,i:6)? 
until false? 

end. 


TOPATH.ASM is from "Better Batch Files Through Assembler", by 
William J. Claff, BYTE, IBM Special Issue, 1987, page 159. 


CODE 


TAILLEN 

TAIL 


SEGMENT 




ASSUME 

CS:CODE 

?<- ASSUMES 

FOR .COM FILE 

ASSUME 

DS:CODE 



ASSUME 

ESiCODE 



ASSUME 

SS:CODE 



ORG 

00080H 

?<- LENGTH OF COMMAND TAIL 

DB 

? 



ORG 

00081H 

?<- COMMAND 

TAIL 

DB 

127 DUP(?) 
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ORG 

00100H 

?<- REQUIRED FOR .COM FILE 

IP 

LABEL 

NEAR 

? (USED ON END STATEMENT) 


XOR 

BH, BH 

?<- PUT NUL AT END OF COMMAND TAIL 


MOV 

BL,TAILLEN 



MOV 

TAIL[BX],000H 



MOV 

AL, ' ' 

?<- SCAN FORWARD ACROSS BLANKS 


MOV 

CX, BX 



MOV 

DI,OFFSET TAIL 



CLD 




REPE 

SCAS TAIL[DI] 



DEC 

DI 



MOV 

AH,03BH 

;<- CHANGE DIRECTORY 


MOV 

DX, DI 



INT 

021H 



JC 

EXIT 



XOR 

AL, AL 


EXIT 

LABEL 

NEAR 

;<- EXIT 


MOV 

AH,04CH 

; 0=OK OTHERWISE=ERROR NUMBER 


INT 

021H 


CODE 

ENDS 




END 

IP 

?<- REQUIRED FOR .COM FILE 


WINDOW.BAS is from "Windows for BASIC", by John W. Ross, BYTE, 
IBM Special Issue, 1987, page 201. 


100 • WINDOW.BAS - program to generate WINDOW.EXE 
110 • 


120 

■ Copyright 

(C) John W. 

Ross 1986 



130 

i 








140 

OPEN”window.exe” AS #2 LEN=1 




150 

FIELD 

n, 

1 AS Z$ 





160 

READ A$ 







170 

WHILE A$<>”-1 

N 





180 

C$= 

”&h" 

+A$ 






190 

C=VAL(C$) 






200 

0$=MKI$(C) 






210 

LSET Z$ 

=LEFT$(0$,1) 





220 

PUT #2 







230 

READ A$ 







240 1 

WEND 








1000 

DATA 

4D, 

5A, 

40, 00, 03, 

00, 

02, 00, 

20, 

00, 

1010 

DATA 

00, 

12, 

C6, 00, 00, 

22, 

00, IE, 

00, 

00, 

1020 

DATA 

1A, 

00, 

22, 00, 00, 

00, 

00, 00, 

00, 

00, 

1030 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1040 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1050 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1060 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1070 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1080 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1090 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1100 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1110 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1120 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1130 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1140 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1150 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1160 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1170 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1180 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1190 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1200 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1210 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1220 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1230 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1240 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1250 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1260 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1270 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1280 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1290 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, 00, 

00, 

00, 

1300 

DATA 

00, 

00, 

55, 8B, EC, 

IE, 

06, 16, 

EB, 

39, 

1310 

DATA 

67, 

68, 

74, 20, 28, 

43, 

29, 20, 

4 A, 

6F, 

1320 

DATA 

6F, 

73, 

73, 20, 31, 

39, 

38, 36, 

00, 

00, 

1330 

DATA 

00, 

00, 

00, 00, 00, 

00, 

00, B8, 

00, 

B9, 

1340 

DATA 

5E, 

06, 

8B, 07, 2E, 

A2, 

34, 00, 

8B, 

5E, 

1350 

DATA 

8B, 

5E, 

OA, 8B, 07, 

2E, 

A3, 2E, 

00, 

8B, 

1360 

DATA 

00, 

8B, 

5E, OE, 88, 

07, 

2E, A3, 

2A, 

00/ 

1370 

DATA 

35, 

00, 

IE, B8, 00, 

00, 

BE, 1)8, 

B4, 

OF, 


00, 

00, 

FF, 

FF, 

18, 

00, 

AO 

00, 

01, 

00, 

79, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

00, 

00, 

00, 

00, 

00, 

00 

90, 

43, 

6F, 

70, 

79, 

72, 

69 

68, 

6E, 

20, 

57, 

2E, 

20, 

52 

00, 

00, 

00, 

00, 

00, 

00, 

00 

00, 

BA, 

00, 

BB, 

00, 

BO, 

8B 

08, 

8B, 

07, 

2E, 

A3, 

2C, 

00 

5E, 

OC, 

8B, 

07, 

2E, 

A3, 

28 

8B, 

5E, 

10, 

8B, 

07, 

2E, 

A3 

CD, 

10 , 

3C, 

02, 

74, 

OC, 

3C 
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1380 

DATA 

03, 74, 08, 

3C, 

1390 

DATA 

DF, B7, 00, 

89, 

1400 

DATA 

08, 00, 8B, 

97, 

1410 

DATA 

F6, E6, B6, 

00, 

1420 

DATA 

2E, 00, Al, 

35, 

1430 

DATA 

CA, B5, 00, 

51, 

1440 

DATA 

26, 8B, OF, 

89, 

1450 

DATA 

59, E2, D8, 

OE, 

1460 

DATA 

8A, 26, 34, 

00, 

1470 

DATA 

B6, BA, BO, 

20, 

1480 

DATA 

2C, 00, E8, 

IF, 

1490 

DATA 

CD, 8A, 26, 

34, 

1500 

DATA 

OE, 00, 53, 

26, 

1510 

DATA 

26, 88, 27, 

43, 

1520 

DATA 

00, 00, 00, 

00, 

1530 

DATA 

20, 20, 20, 

73, 

1540 

DATA 

20, 20, 73, 

74, 

1550 

DATA 

20, 73, 74, 

61, 

1560 

DATA 

73, 74, 61, 

63, 

1570 

DATA 

74, 61, 63, 

6B, 

1580 

DATA 

61, 63, 6B, 

20, 

1590 

DATA 

63, 6B, 20, 

20, 

1600 

DATA 

6B, 20, 20, 

20, 

1610 

DATA 

20, 20, 20, 

73, 

1620 

DATA 

20, 20, 06, 

33, 

1630 

DATA 

C7, 06, FO, 

04, 

1640 

DATA 

-1 



07, 

74, 

04, 

IF, 

E9, 

BC, 

IE, 

32, 

00, 

Dl, 

E3, 

83, 

37, 

00, 

52, 

8A, 

36, 

2A, 

03, 

C2, 

Dl, 

EO, 

8B, 

D8, 

00, 

IF, 

8B, 

7E, 

12, 

53, 

3D, 
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BBS’S POSTING BYTENET LISTINGS 


Australia: 

Grayham Smith 
12 Brentwood Road 
Flinders Park, South Australia 5025 
The Electronic Oracle 
300 Baud, CCITT Standard 
Telephone: 08-43-3331 Voice 
08-260-6686 BBS 

Edward A. Romer 
31 Warwick Street 
Killara. 

Sydney NSW. Australia 2071 
OMEN 

300 & 1200 Baud 
Telephone: 02-498-2399 
Voice (Work) 

02-499-2642 Voice (Home) 

02-498-2495 BBS 

Alan Salmon 
PCUG Sysop 
GPO Box 2229 
Canberra, 

A.C.T. 2601, Australia 
Canberra PC Users Group Inc. 

300 & 1200 Baud 
Telephone: 61-62-58-9967 BBS 

Angus S. Bliss 
POB 293 

Hamilton NSW 2303, Australia 

Newcastle Microcomputer Club 

300 Baud, CCITT Standard. 8 Bits. 1 Stop. No Parity 

Telephone: 049-67-2433 Voice (Angus Bliss) 

049-54-9505 Voice (Tony Nicholson) 
61-49-685385 BBS 

John Hastwell-Batten 
POB 242 

Dural, NSW 2158, Australia 
Tesseract RCPM+ 

300 Baud, CCITT Standard, 8 Bits, No Parity 
Telephone: 02-651-2363 Voice 
02-651-1404 BBS 

Phil Harding 
POB 35 

Charnwood A.C.T., Australia 2615 
PC-Exchange Bulletin Board 
300 & 1200 Baud. CCITT Standard 
Telephone: 61-062-581406 Voice 
61-62-586352 BBS 

Eric Salter 
POB 60 

Canterbury 3126. Australia 

MICOM: The Microcomputer Club of Melbourne 

300 Baud 

Telephone: 61-3-861-9117 Enc Salter 

61 -3-762-1386 Peter Jetsoo (SYSOP) 
61-3-762-5088 BBS 

Craig Bowen 

29 Warrigal Road 

Surrey Hills 3127, Vic., Australia 

Public Resource 01 

300 Baud, CCITT Standard. 8 Bits. 1 Stop. No ftrr% 
Telephone: 03-890-2174 

John Blackett-Smith 
Unit 8 

69 Wattle Road 
Hawthorn 3122, Australia 
The National Fido 
Telephone: 613-818-2336 


Austria: 

Wolfgang Hryzak 
Bahnstrasse 48 
A-2230 Gansemdorf, Austria 
University of Vienna BBS FIDO 
300 Baud, 8 Bits, 1 Stop Bit 
Telephone: 02282-24094 BBS 

Brazil: 

Sistema Sampa 
ATTN: Rizieri Maglio 
R. Portugal. 202 
Jdm Europe - CEP 01446 
Sao Paulo - SP - Brazil 
Sistema Sampa 

300 & 1200 Baud. CCITT Standard 
Telephone: 011-8536273 BBS 

Canada: 

Leigh Calnek 
3036 25th Avenue 

Regina. Saskatchewan. Canada S4S 1K9 
Telephone: 306-586-9253 BBS 

Tom Kashuba 

PCOMM Systems 

1411 Fort Street, Suite 2001 

Montreal, Quebec, Canada H3H 2N7 

Telephone: 514-989-9450 BBS 

Gary McCallum 

Western Canadian Distribution Center 
342048th Street 

Edmonton, Alberta. Canada T6L 3R5 
300 & 1200 & 2400 Baud 
Telephone: 403-462-9189 Voice 
403-461-9124 BBS 

Judson Newell 

Canada Remote Systems 

Suite 311,4198 Dundas Street West 

Toronto. Ontario. Canada M8X IY6 

Telephone: 416-231-2383 Voice 

416-231-9202 BYTEnet System 

Vernon Paige 
EPSNUNK 
3 McNicoll Avenue 

Willowdale, Ontario. Canada M2H 2A6 
300 & 1200 Baud 
Telephone: 416-494-1380 Voice 
416-635-9600 BBS 

Tern S my the 
Sysop. Z-Node 40 
Muddy Water User Group 
55 Roland Avenue 

Wjgapeg. Nteaota. Canada R3J 2N6 
Tefepfcooe 20t-£3:-39g2 Voce 
304-^45-6713 Voice 
204-S32U59? BBS 


Chile: 

E-“v3uc Bctjt* Z 
Guetknno Gocnara C 
Ejcottc Yanez 2210 

Sastapc deQ*k 
9GSA3SS 

lax 330300 Bell Sl CCITT 
5G-749B48 

> •* m id 4 00 am (Chilean time) 
Si Uploads 
Vnodes. ASCII 


Denmark: 

Beverly Kleiman 
International Representative 
Personal Computer Society of Denmark 
Kronprinsensgade 14, 

DK-1114 Copenhagen, Denmark 
300 Baud. CCITT Standard 
Telephone: 01-122518 BBS 

England: 

Frank Thomley 
67 Woodbridge Road, 

Guildford. 

Surrey GU21 UP, United Kingdom 
CompuLink 

Telephone: 0-483-65895 Voice 

0-483-573337 (300/1200 Baud) BBS 
0-483-573338 (1200/2400 Baud) BBS 

Finland: 

Juha Wiio 
Databox Oy 
Museokatu 11 
00100 Helsinki, Finland 
DATABOX FIDO 
300 & 1200 Baud 
Telephone: 358-0-497904 

Vivian Ronald Dwight 
Suvikuja 3 B 14 
02120 Espoo, Finland 
Micro Maniacs III Fido Node 1 7 
300 & 1200 & 2400 Baud 
Telephone: 358-0-424524 Voice 
358-0-4557307 Voice 
358-0-467673 BBS 

France: 

Bill Graham. 

President 

OUF! (Ordinateurs Utilisateurs France) 

ATTN: OUFLOG, B.P. 62 
10 rue Saint Nicolas 
75012 Paris, France 
300 Baud. CCITT Standard 
Telephone: 331-43-44-06-48 Voice (Bill) 
331-43-44-82-65 Voice 
331-43-41-61-47 OUFLOG 
for BYTE Listings 
331-43-40-33-79 OUFTEL 
300 & 1200 Baud 
331-43-07-95-39 OUFTEL 

Dr. Bernard Pidoux 

Groupe Des Utilisateurs Francophones D Tnformatique 

37. Boulevard Saint-Jacques 

75014 Pans. France 

300 Baud. CCITT Standard 

Telephone: 1-47-63-72-50 Voice 

1-45-65-10-09 GUFINET 
1-45-65-10-11GUFITEL 

Hong Kong: 

W. A. Hanafi 
SEAnet 

Suite 812, Star House, 

Tsim Sha Tsui. Kowloon, Hong Kong 
ATTN: Christine Wong 
Telephone: 5-455088 Voice 

5-8937856 SEAnet 1 
5-724495 SEAnet 2 

continued 
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Indonesia: 

James D. Filgo 

US Embassy Box R 

APO SF 96356-5000 

Jakarta Computer Society 

300 Baud, Bell & CCITT Standard 

Telephone: 062-21-799-3286 BBS 

Israel: 

Zohar Levitan 
POB 10279 
Tshala 61102 
Israel 

(Contact for telephone number) 

Ireland: 

Gerry Clarke 
30 Auburn Road 

Dunlaoire County, Dublin, Ireland 
Dublin Bax Bulletin Board 
300 & 1200 Baud 
Telephone: 353-01-854179 

Italy: 

Bruno Bonino 
MICRO design s.r.l. 

Via Rostan, 1 
16155 Genova. Italy 
C.B.B.S. 

CCITT & Bell Standard 
Telephone: 10-687098 Voice 
10-688783 BBS 

Giorgio Leo Rutigliano 
Via degli Oleandri, 7 
POB 175 

85100-Potenza, Italy 

FIDO-PZ 

300 Baud 

Telephone: 0971-34593 Voice (Work) 

0971-54431 Voice (Home) 

0971-35447 BBS 

Claudio Yandelli 
Amministratore Unico 
SOFT SERVICE s.r.l. 

ViaG. B. Morgagni 32 
20129 Milano, Italy 
SOFT SERVICE BBS 

300 Baud, CCITT Standard, 8 Bits, No Parity. Full 
Duplex 

Telephone: 02-209231 Voice 
02-228467 BBS 

Paolo Marraffa 
Computronix 
Via De Amicis 76 
90145 Palermo, Italy 
Network Computer Club 

300 Baud, CCITT Standard, 8 Bits, 1 Stop Bit. Full 
Duplex 

Telephone: 39-91-266021 BBS 
39-91-300229 BBS 


Japan: 

Peter Perkins 
Vice President 

Honda Trading Company Ltd. 

Mail 101 

9-91-Chome, Sou Kanda 
Chiyoda-ku, Tokyo, Japan 
JANIS 

300 & 1200 Baud. CCITT Sundard 
Telephone: 03-251-0855 BBS 

Malaysia: 

Ong Boo Huat 
3, Jalan Pisang 

Jalan Kelang Lama, 58000 Kuala Lumpur 

STARUNK 

300 Baud 

Telephone: 03-7578811 X 116 Voice 
03-7576644 BBS 


Nigeria: 

Chester W. Vlaun 
MTCE/31 
POB 263 

Port Harcourt, Nigeria. West Africa 
300 Baud 

Telephone: 234-84-301210 to 301229-3022 

Norway: 

Robert Hertz 
Hertz Data Inc. 

Huitssfeldts Gate 16 
N-0253 Oslo, Norway 
Hacker's Unlimited 
Telephone: 47-2-431655 Voice 
47-2-390521 BBS 

Helge Vindenes 
5670 FUSA, Norway 
Costa del 

Telephone: 47-5-151610 Voice 
47-5-234129 BBS 

Saudi Arabia: 

Larry Layland 
System Operator DPCS 
Aramco 
Box 10063 

Dhahran, Saudi Arabia 31311 

Dhahran Personal Computing Society Bulletin Board 

Telephone: 03-873-7851 BBS 

Singapore: 

Ken Ong 

10 Orange Grove Road 
#04-01 

Singapore 1025, Singapore 
K.B.B.S. 

300 & 1200 Baud 

Telephone: (IDD) 65-734-5825 Voice 
ODD) 65-737-4090 BBS 


Sweden: 

Jacob Palme 

Stockholm University Computer Centre-QZ 
Box 27322 

102 54 Stockholm, Sweden 
BYTECOM 

Telephone: 46-8-65-45-00 Voice (Work) 
08-23-86-60 (300 Baud) 
08-23-89-30(300 Baud) 
08-15-59-20(300 Baud) 
08-14-35-00(1200 Baud) 
08-22-81-30(1200 Baud) 
08-24-61-20(1200 Baud) 
08-14-53-70(1200 Baud) 

Carl Nordin 

Nyakersgaun 8B 

531 41 Lidkoping, Sweden 

A.T.L 

300 & 1200 Baud, CCITT Sundard 
Telephone: 46-510-25280 Voice 
46-510-20409 BBS 

Switzerland: 

Peter M. C. Werner 
9, rue de la Colombiere 
1260 Nyon, Switzerland 
OCTET 

300 & 1200 & 2400 Baud, CCITT Sundard 
Telephone: 41-22-62-16-54 Voice 
41-22-62-18-17 BBS 

Albert F. Studer 
Technical Director 
Kupfer Electronic AG 
Soodstrasse 53 

Postfach, 8134 Adliswil, Switzerland 
TRAX 

300 Baud, CCITT Sundard 
Telephone: 01-710-81-11 Voice 
01-710-44-36 BBS 


The Netherlands: 

Henk Wevers 

Cloeckendaal 38 

6715 GH Ede, The Netherlands 

Henk Wevers ' Fido 

Telephone: 31-8380-37156 BBS 

West Germany: 

Rupert Mohr 

RMI Nachrichtentechnik GmbH 
RosstraBe 7 
Postfach 1526 

D-5100 Aachen, West Germany 
RMI Net 

Telephone: 49-241-21145 Voice 

45-2410-90528 BYTEnet - DATEX-P 
0-26245-2410-90528 User Dau - DATEX-P 

Rudolf Strieker 
Unsoeldstr. 20 

D-8000 Munich 22. West Germany 
T-BUS FIDO 

Telephone: 089-29-38-81 BBS 
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Announcing BYTE’s 
New Subscriber Benefits 


y 

-Lour BYTE subscription brings 
you a complete diet of the latest in 
microcomputer technology every 
30 days. The kind of broad-based 
objective coverage you read in 
every issue. In addition , your 
subscription carries a wealth of 
other benefits. Check the check 
list: 

DISCOUNTS 

0 13 issues instead of 12 if you 
send payment with subscription 
order. 

One-year subscription at $21 
(50% off cover price). 

Two-year subscription at $38. 

±i Three-year subscription at $55. 

(0 One-year GROUP subscription 
for ten or more at $17.50 each. 
(Call or write for details.) 

SERVICES 

^ BIX: BYTE’s Information 
Exchange puts you on-line 24 
hours a day with your peers 
via computer conferencing and 
electronic mail. All you need to 
sign up is a microcomputer, a 
modem, and telecomm 
software. 

0 Reader Service: For information 
on products advertised in 
BYTE, circle the numbers on 
the Reader Service card 
enclosed in each issue that 
correspond to the numbers for 
the advertisers you select. Drop 
it in the mail and we’ll get 
your inquiries to the advertisers. 

El TIPS: BYTE’s Telephone 
Inquiry System is available to 


Program 


BYTE ^ 



subscribers who need fast 
response. After obtaining your 
Subscriber I.D. Card, dial TIPS 
and enter your inquiries. You’ll 
save as much as ten days over 
the response to Reader Service 
cards. 

!0 Disks and Downloads: 

Listings of programs that 
accompany BYTE articles are 
now available free on the 
BYTEnet bulletin board, and 
cm disk or in quarterly printed 
supplements. 

Microform: BYTE is available 
in microform from University 
Microfilm International in the 
US and Europe. 

0 BYTTi BOMB: BYTE's 
Onacir^ Manner Bax s your 
dmect me me eccar's desk. 
Facr nxc. -.cc can race die 
amcjf< me Reader Service 
card. \ckt redback heirs us 


keep up to date on your 
information needs. 

ij Customer Service: If you have 
a problem with, or a question 
about, your subscription, you 
may phone us during regular 
business hours (Eastern time) 
at our toll-free number: 800- 
258-5485. You can also use 
Customer Service to obtain 
back issues and editorial indexes. 

BONUSES 

0 Annual Separate Issues: In 
addition to BYTE’s 12 monthly 
issues, subscribers also receive 
our annual IBM PC issue free 
of charge, as well as any other 
annual issues BYTE may 
produce. 

BYTE Deck: Subscribers 
receive five BYTE postcard 
deck mailings each year—a 
direct response system for you 
to obtain information on 
advertised products through 
return mail. 

To be on the leading edge of 
microcomputer technology and 
receive all the aforementioned 
benefits, make a career decision 
today. Call toll-free weekdays, 
8:30am to 4:30pm Eastern time: 
800-258-5485. 

And. . . welcome to 
BYTE country! 











n**' Introducing Turbo C 1.5— 
the best optimizing compiler 
gets even better! 



Actual photograph ol Turbo C graphics displayed on IBM 8514 screen * 


The professional 
optimizing compiler 
for less than $100 
Turbo C* is a techni¬ 
cally superior produc¬ 
tion-quality compiler. 
(Borland’s equation sol¬ 
ver. Eureka", is written in 
Turbo C.) And our Turbo 
C 1.5 offers a new library 
of the highest presenta¬ 
tion-quality graphics in 
the industry—the kind 
you’ll see in Quattro," 
our new professional 
spreadsheet. 

And spectacular graph¬ 
ics are just part of the 
brand-new features. 

Turbo C 1.5 enhance¬ 
ments also include: 

• A professional-quality 
graphics library of over 
70 functions 

• A librarian that allows you 
to build your own object 
module libraries 

• Context-sensitive help for 
the language and the 
library routines 


• Text/video functions, 
including windows 

• 43- and 50-line mode 
support 

• VGA. CGA. EGA. Hercules, 
and IBM 8514 support 

• File search utility (GREP) 



INTERNATIONAL 


• Sample graphics 
applications 

♦ More than 100 new 
functions 

For professional-quality C 
at an affordable price, no one 
else comes close to Turbo C. 
Because no one can deliver 
technical superiority like 
Borland. 

60-Day Money-back Guarantee ** 

For the dealer nearest 
you or to order, call 

( 800 ) 543-7543 


UUalmem syittm rtqwirtmtati: for I* IBM PS/2* and the IBM* and Compaq* tamikes Ol personal computers and HI 100% compattHes PC-DOSIMS-OOS*) 2 0 Of later 384K. 

‘Artwork metafile cootesy ol Gertgraphcs* Corporation 

“Customer satisfaction is ou main concern: f mita 60 days ot purchase the product does not perform m accordance with w dams, call our customer service department, and we win arrange a reftxwd 
u Bonn: products n noewu «rtpwrte ramm or Boom nrave me Oewr tnm M ixoouc w« arc ndrau or icgawne raJcnm u me* -tweet* men Cow«i tow wtmworw. me to ii6Sa 


It’s easy to upgrade to Thrbo C 1.5! 

Just complete this coupon and mail it with payment before June 30.1988 Or. call us at (800) 543-7543 and be ready to give our operators your name, 
credit card number, and the serial number on your Turbo C master disk. 

Turbo C 1.5 Upgrade Price $ 33.50 


CA and MA residents add sales tax - 

Shipping and handing 

In US $5.00 (Outside US add $10) - 

Total amount enclosed $ - 

Must include your Turbo C serial f_ 

Return this coupon and the Turbo C RTl source code registration form from your Turbo 
C manual along with your payment by March 31.1988 and receive you Turbo C 1.5 
upgrade for free 1 (No phone orders please) 

Turbo C 1.5 Runtime Library 
Source Code S 150.00 

CA & MA residents add sales tax - 

Price includes shipping to all US cities 

(Outside US add $10) _ 

Total amount enclosed $ - 


Please specify diskette size □ 5V4* □ 3V4* 

Method ol Payment: □ VISA □ MC □ Check □ Bank Draft 

Credit card expiration date:-/- 


Name-—— 

Ship Address --- 

City_State- 

Zip _Phone (-) - 

Mail coupon to: Turbo C 1.5 Upgrade Dept. Borland International 
4585 Scotts valley Drive. Scotts valley. CA 95066 
This otto a touted to one upgrade per vaM product serai carter Not good wte «iy otter oiler hom 
Borland Outside US (mice payments by bar* draff payable in US dollars drawn on a US bank. 

COOs and puctase orders win not be accepted by 8ortand 




























